init

.dir-locals.el

@@ -0,0 +1,5 @@
+(
+  ("src" .  ((nil . ((dante-target . "fedi")))))
+
+  ("app" .  ((nil . ((dante-target . "exe:fedi")))))
+)

.gitignore

@@ -0,0 +1,6 @@
+dist-newstyle/
+newdist/
+templates/
+website/
+user-data/
+out/

LICENSE

@@ -0,0 +1,373 @@
+Mozilla Public License Version 2.0
+==================================
+
+1. Definitions
+--------------
+
+1.1. "Contributor"
+    means each individual or legal entity that creates, contributes to
+    the creation of, or owns Covered Software.
+
+1.2. "Contributor Version"
+    means the combination of the Contributions of others (if any) used
+    by a Contributor and that particular Contributor's Contribution.
+
+1.3. "Contribution"
+    means Covered Software of a particular Contributor.
+
+1.4. "Covered Software"
+    means Source Code Form to which the initial Contributor has attached
+    the notice in Exhibit A, the Executable Form of such Source Code
+    Form, and Modifications of such Source Code Form, in each case
+    including portions thereof.
+
+1.5. "Incompatible With Secondary Licenses"
+    means
+
+    (a) that the initial Contributor has attached the notice described
+        in Exhibit B to the Covered Software; or
+
+    (b) that the Covered Software was made available under the terms of
+        version 1.1 or earlier of the License, but not also under the
+        terms of a Secondary License.
+
+1.6. "Executable Form"
+    means any form of the work other than Source Code Form.
+
+1.7. "Larger Work"
+    means a work that combines Covered Software with other material, in
+    a separate file or files, that is not Covered Software.
+
+1.8. "License"
+    means this document.
+
+1.9. "Licensable"
+    means having the right to grant, to the maximum extent possible,
+    whether at the time of the initial grant or subsequently, any and
+    all of the rights conveyed by this License.
+
+1.10. "Modifications"
+    means any of the following:
+
+    (a) any file in Source Code Form that results from an addition to,
+        deletion from, or modification of the contents of Covered
+        Software; or
+
+    (b) any new file in Source Code Form that contains any Covered
+        Software.
+
+1.11. "Patent Claims" of a Contributor
+    means any patent claim(s), including without limitation, method,
+    process, and apparatus claims, in any patent Licensable by such
+    Contributor that would be infringed, but for the grant of the
+    License, by the making, using, selling, offering for sale, having
+    made, import, or transfer of either its Contributions or its
+    Contributor Version.
+
+1.12. "Secondary License"
+    means either the GNU General Public License, Version 2.0, the GNU
+    Lesser General Public License, Version 2.1, the GNU Affero General
+    Public License, Version 3.0, or any later versions of those
+    licenses.
+
+1.13. "Source Code Form"
+    means the form of the work preferred for making modifications.
+
+1.14. "You" (or "Your")
+    means an individual or a legal entity exercising rights under this
+    License. For legal entities, "You" includes any entity that
+    controls, is controlled by, or is under common control with You. For
+    purposes of this definition, "control" means (a) the power, direct
+    or indirect, to cause the direction or management of such entity,
+    whether by contract or otherwise, or (b) ownership of more than
+    fifty percent (50%) of the outstanding shares or beneficial
+    ownership of such entity.
+
+2. License Grants and Conditions
+--------------------------------
+
+2.1. Grants
+
+Each Contributor hereby grants You a world-wide, royalty-free,
+non-exclusive license:
+
+(a) under intellectual property rights (other than patent or trademark)
+    Licensable by such Contributor to use, reproduce, make available,
+    modify, display, perform, distribute, and otherwise exploit its
+    Contributions, either on an unmodified basis, with Modifications, or
+    as part of a Larger Work; and
+
+(b) under Patent Claims of such Contributor to make, use, sell, offer
+    for sale, have made, import, and otherwise transfer either its
+    Contributions or its Contributor Version.
+
+2.2. Effective Date
+
+The licenses granted in Section 2.1 with respect to any Contribution
+become effective for each Contribution on the date the Contributor first
+distributes such Contribution.
+
+2.3. Limitations on Grant Scope
+
+The licenses granted in this Section 2 are the only rights granted under
+this License. No additional rights or licenses will be implied from the
+distribution or licensing of Covered Software under this License.
+Notwithstanding Section 2.1(b) above, no patent license is granted by a
+Contributor:
+
+(a) for any code that a Contributor has removed from Covered Software;
+    or
+
+(b) for infringements caused by: (i) Your and any other third party's
+    modifications of Covered Software, or (ii) the combination of its
+    Contributions with other software (except as part of its Contributor
+    Version); or
+
+(c) under Patent Claims infringed by Covered Software in the absence of
+    its Contributions.
+
+This License does not grant any rights in the trademarks, service marks,
+or logos of any Contributor (except as may be necessary to comply with
+the notice requirements in Section 3.4).
+
+2.4. Subsequent Licenses
+
+No Contributor makes additional grants as a result of Your choice to
+distribute the Covered Software under a subsequent version of this
+License (see Section 10.2) or under the terms of a Secondary License (if
+permitted under the terms of Section 3.3).
+
+2.5. Representation
+
+Each Contributor represents that the Contributor believes its
+Contributions are its original creation(s) or it has sufficient rights
+to grant the rights to its Contributions conveyed by this License.
+
+2.6. Fair Use
+
+This License is not intended to limit any rights You have under
+applicable copyright doctrines of fair use, fair dealing, or other
+equivalents.
+
+2.7. Conditions
+
+Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted
+in Section 2.1.
+
+3. Responsibilities
+-------------------
+
+3.1. Distribution of Source Form
+
+All distribution of Covered Software in Source Code Form, including any
+Modifications that You create or to which You contribute, must be under
+the terms of this License. You must inform recipients that the Source
+Code Form of the Covered Software is governed by the terms of this
+License, and how they can obtain a copy of this License. You may not
+attempt to alter or restrict the recipients' rights in the Source Code
+Form.
+
+3.2. Distribution of Executable Form
+
+If You distribute Covered Software in Executable Form then:
+
+(a) such Covered Software must also be made available in Source Code
+    Form, as described in Section 3.1, and You must inform recipients of
+    the Executable Form how they can obtain a copy of such Source Code
+    Form by reasonable means in a timely manner, at a charge no more
+    than the cost of distribution to the recipient; and
+
+(b) You may distribute such Executable Form under the terms of this
+    License, or sublicense it under different terms, provided that the
+    license for the Executable Form does not attempt to limit or alter
+    the recipients' rights in the Source Code Form under this License.
+
+3.3. Distribution of a Larger Work
+
+You may create and distribute a Larger Work under terms of Your choice,
+provided that You also comply with the requirements of this License for
+the Covered Software. If the Larger Work is a combination of Covered
+Software with a work governed by one or more Secondary Licenses, and the
+Covered Software is not Incompatible With Secondary Licenses, this
+License permits You to additionally distribute such Covered Software
+under the terms of such Secondary License(s), so that the recipient of
+the Larger Work may, at their option, further distribute the Covered
+Software under the terms of either this License or such Secondary
+License(s).
+
+3.4. Notices
+
+You may not remove or alter the substance of any license notices
+(including copyright notices, patent notices, disclaimers of warranty,
+or limitations of liability) contained within the Source Code Form of
+the Covered Software, except that You may alter any license notices to
+the extent required to remedy known factual inaccuracies.
+
+3.5. Application of Additional Terms
+
+You may choose to offer, and to charge a fee for, warranty, support,
+indemnity or liability obligations to one or more recipients of Covered
+Software. However, You may do so only on Your own behalf, and not on
+behalf of any Contributor. You must make it absolutely clear that any
+such warranty, support, indemnity, or liability obligation is offered by
+You alone, and You hereby agree to indemnify every Contributor for any
+liability incurred by such Contributor as a result of warranty, support,
+indemnity or liability terms You offer. You may include additional
+disclaimers of warranty and limitations of liability specific to any
+jurisdiction.
+
+4. Inability to Comply Due to Statute or Regulation
+---------------------------------------------------
+
+If it is impossible for You to comply with any of the terms of this
+License with respect to some or all of the Covered Software due to
+statute, judicial order, or regulation then You must: (a) comply with
+the terms of this License to the maximum extent possible; and (b)
+describe the limitations and the code they affect. Such description must
+be placed in a text file included with all distributions of the Covered
+Software under this License. Except to the extent prohibited by statute
+or regulation, such description must be sufficiently detailed for a
+recipient of ordinary skill to be able to understand it.
+
+5. Termination
+--------------
+
+5.1. The rights granted under this License will terminate automatically
+if You fail to comply with any of its terms. However, if You become
+compliant, then the rights granted under this License from a particular
+Contributor are reinstated (a) provisionally, unless and until such
+Contributor explicitly and finally terminates Your grants, and (b) on an
+ongoing basis, if such Contributor fails to notify You of the
+non-compliance by some reasonable means prior to 60 days after You have
+come back into compliance. Moreover, Your grants from a particular
+Contributor are reinstated on an ongoing basis if such Contributor
+notifies You of the non-compliance by some reasonable means, this is the
+first time You have received notice of non-compliance with this License
+from such Contributor, and You become compliant prior to 30 days after
+Your receipt of the notice.
+
+5.2. If You initiate litigation against any entity by asserting a patent
+infringement claim (excluding declaratory judgment actions,
+counter-claims, and cross-claims) alleging that a Contributor Version
+directly or indirectly infringes any patent, then the rights granted to
+You by any and all Contributors for the Covered Software under Section
+2.1 of this License shall terminate.
+
+5.3. In the event of termination under Sections 5.1 or 5.2 above, all
+end user license agreements (excluding distributors and resellers) which
+have been validly granted by You or Your distributors under this License
+prior to termination shall survive termination.
+
+************************************************************************
+*                                                                      *
+*  6. Disclaimer of Warranty                                           *
+*  -------------------------                                           *
+*                                                                      *
+*  Covered Software is provided under this License on an "as is"       *
+*  basis, without warranty of any kind, either expressed, implied, or  *
+*  statutory, including, without limitation, warranties that the       *
+*  Covered Software is free of defects, merchantable, fit for a        *
+*  particular purpose or non-infringing. The entire risk as to the     *
+*  quality and performance of the Covered Software is with You.        *
+*  Should any Covered Software prove defective in any respect, You     *
+*  (not any Contributor) assume the cost of any necessary servicing,   *
+*  repair, or correction. This disclaimer of warranty constitutes an   *
+*  essential part of this License. No use of any Covered Software is   *
+*  authorized under this License except under this disclaimer.         *
+*                                                                      *
+************************************************************************
+
+************************************************************************
+*                                                                      *
+*  7. Limitation of Liability                                          *
+*  --------------------------                                          *
+*                                                                      *
+*  Under no circumstances and under no legal theory, whether tort      *
+*  (including negligence), contract, or otherwise, shall any           *
+*  Contributor, or anyone who distributes Covered Software as          *
+*  permitted above, be liable to You for any direct, indirect,         *
+*  special, incidental, or consequential damages of any character      *
+*  including, without limitation, damages for lost profits, loss of    *
+*  goodwill, work stoppage, computer failure or malfunction, or any    *
+*  and all other commercial damages or losses, even if such party      *
+*  shall have been informed of the possibility of such damages. This   *
+*  limitation of liability shall not apply to liability for death or   *
+*  personal injury resulting from such party's negligence to the       *
+*  extent applicable law prohibits such limitation. Some               *
+*  jurisdictions do not allow the exclusion or limitation of           *
+*  incidental or consequential damages, so this exclusion and          *
+*  limitation may not apply to You.                                    *
+*                                                                      *
+************************************************************************
+
+8. Litigation
+-------------
+
+Any litigation relating to this License may be brought only in the
+courts of a jurisdiction where the defendant maintains its principal
+place of business and such litigation shall be governed by laws of that
+jurisdiction, without reference to its conflict-of-law provisions.
+Nothing in this Section shall prevent a party's ability to bring
+cross-claims or counter-claims.
+
+9. Miscellaneous
+----------------
+
+This License represents the complete agreement concerning the subject
+matter hereof. If any provision of this License is held to be
+unenforceable, such provision shall be reformed only to the extent
+necessary to make it enforceable. Any law or regulation which provides
+that the language of a contract shall be construed against the drafter
+shall not be used to construe this License against a Contributor.
+
+10. Versions of the License
+---------------------------
+
+10.1. New Versions
+
+Mozilla Foundation is the license steward. Except as provided in Section
+10.3, no one other than the license steward has the right to modify or
+publish new versions of this License. Each version will be given a
+distinguishing version number.
+
+10.2. Effect of New Versions
+
+You may distribute the Covered Software under the terms of the version
+of the License under which You originally received the Covered Software,
+or under the terms of any subsequent version published by the license
+steward.
+
+10.3. Modified Versions
+
+If you create software not governed by this License, and you want to
+create a new license for such software, you may create and use a
+modified version of this License if you rename the license and remove
+any references to the name of the license steward (except to note that
+such modified license differs from this License).
+
+10.4. Distributing Source Code Form that is Incompatible With Secondary
+Licenses
+
+If You choose to distribute Source Code Form that is Incompatible With
+Secondary Licenses under the terms of this version of the License, the
+notice described in Exhibit B of this License must be attached.
+
+Exhibit A - Source Code Form License Notice
+-------------------------------------------
+
+  This Source Code Form is subject to the terms of the Mozilla Public
+  License, v. 2.0. If a copy of the MPL was not distributed with this
+  file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+If it is not possible or desirable to put the notice in a particular
+file, then You may include the notice in a location (such as a LICENSE
+file in a relevant directory) where a recipient would be likely to look
+for such a notice.
+
+You may add additional accurate notices of copyright ownership.
+
+Exhibit B - "Incompatible With Secondary Licenses" Notice
+---------------------------------------------------------
+
+  This Source Code Form is "Incompatible With Secondary Licenses", as
+  defined by the Mozilla Public License, v. 2.0.

app/Main.hs

@@ -0,0 +1,49 @@
+module Main where
+
+import Data.Aeson qualified as A
+import Network.Wai.Handler.Warp (run, Port)
+import Network.Wai.Middleware.RequestLogger qualified as Logger
+import System.Environment (getArgs)
+import System.Environment (lookupEnv)
+import Web.Twain qualified as Twain
+import Fedi qualified as Fedi
+import Data.Functor ((<&>))
+
+main :: IO ()
+main = do
+  getArgs >>= \case
+    [] -> pure ()
+    _ -> usageError
+  fediPort <- maybe 3001 read <$> lookupEnv "FEDI_PORT"
+  runServer fediPort =<< mkFediApp
+
+usageError :: err
+usageError =
+  errorWithoutStackTrace $ unlines
+    [ "Usage: fedi"
+    , "Env vars:"
+    , " - FEDI_PORT=<PORT>"
+    , " - FEDI_DETAILS=<FILE>"
+    ]
+
+-- | Run server at at specific port.
+runServer :: Port -> Twain.Application -> IO ()
+runServer port app = do
+  putStrLn $ unwords
+    [ "Running fedi at"
+    , "http://localhost:" <> show port
+    , "(ctrl-c to quit)"
+    ]
+  run port (Logger.logStdoutDev app)
+
+-- | Application description.
+mkFediApp :: IO Twain.Application
+mkFediApp = do
+  detailsFile <- lookupEnv "FEDI_DETAILS"
+    <&> maybe (error "missing FEDI_DETAILS") id
+  details <- A.decodeFileStrict detailsFile
+    <&> maybe (error $ "could not read file '" <> detailsFile <> "'.") id
+
+  pure $ foldr ($)
+    (Twain.notFound $ Twain.send $ Twain.text "Error: not found.")
+    (Fedi.routes details)

cabal.project

@@ -0,0 +1 @@
+packages: *.cabal

fedi.cabal

@@ -0,0 +1,79 @@
+cabal-version: 3.4
+name: fedi
+version: 0.1.0.0
+license: MPL-2.0
+license-file: LICENSE
+author: campxfire
+maintainer: me@campxfire.space
+category: Web
+build-type: Simple
+extra-doc-files: readme.md
+-- extra-source-files:
+
+common warnings
+  ghc-options: -Wall -fno-warn-type-defaults
+
+library
+  import: warnings
+  exposed-modules:
+    Fedi
+    Fedi.Activity
+    Fedi.Actor
+    Fedi.Routes
+    Fedi.Types
+    Fedi.Webfinger
+  -- other-modules:
+  -- other-extensions:
+  build-depends:
+      aeson
+    , base
+    , bytestring
+    , cmark-gfm
+    , unordered-containers
+    , containers
+    , directory
+    , filepath
+    , htoml-megaparsec
+    , process
+    , text >= 2.0.1
+    , twain
+    , mime-types
+    , time
+
+  hs-source-dirs: src
+  default-language: GHC2021
+  default-extensions:
+    BlockArguments
+    LambdaCase
+    OverloadedRecordDot
+    OverloadedStrings
+    QuasiQuotes
+    DerivingVia
+    GeneralizedNewtypeDeriving
+    DeriveAnyClass
+    DerivingStrategies
+
+executable fedi
+  import: warnings
+  main-is: Main.hs
+  -- other-modules:
+  -- other-extensions:
+  build-depends:
+      aeson
+    , async
+    , base
+    , fedi
+    , wai-extra
+    , warp
+    , twain
+    , text
+
+  hs-source-dirs: app
+  default-language: GHC2021
+  default-extensions:
+    BlockArguments
+    LambdaCase
+    OverloadedRecordDot
+    OverloadedStrings
+    QuasiQuotes
+  ghc-options: -Wall -O -threaded -rtsopts -with-rtsopts=-N

readme.md

@@ -0,0 +1,3 @@
+# fedi
+
+Activitypub library.

src/Fedi.hs

@@ -0,0 +1,7 @@
+module Fedi (module Export) where
+
+import Fedi.Activity as Export
+import Fedi.Actor as Export
+import Fedi.Routes as Export
+import Fedi.Types as Export
+import Fedi.Webfinger as Export

src/Fedi/Activity.hs

@@ -0,0 +1,114 @@
+module Fedi.Activity where
+
+import Data.Aeson qualified as A
+import Data.Text qualified as T
+import Fedi.Types
+import Fedi.Actor
+import Data.Time (UTCTime)
+
+data Activity
+  = Create
+    { createId :: ActivityUrl
+    , actor :: ActorId
+    , object :: Object
+    }
+
+type ActivityUrl = Url
+
+data Object
+  = NoteObject Note
+
+data Note
+  = Note
+    { noteId :: NoteId
+    , notePublished :: UTCTime
+    , noteActor :: ActorId
+    , noteContent :: T.Text
+    , noteName :: Maybe String
+    , noteUrl :: Maybe Url
+    , noteReplies :: Collection Unordered Note
+    }
+type NoteId = Url
+
+type Followers = [Actor]
+type Following = [Actor]
+
+type Inbox = Collection Ordered Activity
+type Outbox = Collection Unordered Activity
+
+data Ordered
+data Unordered
+
+data Collection order a
+  = Collection
+    { collectionSummary :: String
+    , collectionItems :: [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
+        ]
+
+instance A.ToJSON Object where
+  toJSON = \case
+    NoteObject note -> A.toJSON note
+
+instance A.ToJSON Activity where
+  toJSON = \case
+    create@Create{} ->
+      A.object
+        [ "@context" A..=
+          [ "https://www.w3.org/ns/activitystreams" :: String
+          ]
+        , "type" A..= ("Create" :: String)
+        , "id" A..= create.createId
+        , "actor" A..= create.actor
+        , "object" A..= create.object
+        ]
+
+instance A.ToJSON a => A.ToJSON (Collection Ordered a) where
+  toJSON collection =
+    A.object
+      [ "@context" A..=
+        [ "https://www.w3.org/ns/activitystreams" :: String
+        ]
+      , "type" A..= ("OrderedCollection" :: String)
+      , "summary" A..= collection.collectionSummary
+      , "totalItems" A..= length collection.collectionItems
+      , "orderedItems" A..= collection.collectionItems
+      ]
+
+instance A.ToJSON a => A.ToJSON (Collection Unordered a) where
+  toJSON collection =
+    A.object
+      [ "@context" A..=
+        [ "https://www.w3.org/ns/activitystreams" :: String
+        ]
+      , "type" A..= ("Collection" :: String)
+      , "summary" A..= collection.collectionSummary
+      , "totalItems" A..= length collection.collectionItems
+      , "items" A..= collection.collectionItems
+      ]
+
+{-
+  "@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"
+    }
+  ]
+-}

src/Fedi/Actor.hs

@@ -0,0 +1,81 @@
+module Fedi.Actor where
+
+import Data.Aeson qualified as A
+import Fedi.Types
+
+data Actor
+  = Actor
+    { actorId :: Url
+    , actorName :: String
+    , actorPreferredUsername :: String
+    , actorSummary :: String
+    , actorIcon :: Url
+    , actorPublicKey :: PublicKey
+    }
+  deriving Show
+
+type ActorId = Url
+
+data ActorType
+  = Person
+  deriving Show
+
+data PublicKey
+  = PublicKey
+    { pkId :: Url
+    , pkOwner :: Url
+    , pkPublicKeyPem :: Pem
+    }
+  deriving Show
+
+makeActor :: UserDetails -> Actor
+makeActor details =
+  let
+    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 =
+      PublicKey
+        { pkId = actorUrl <> "#main-key"
+        , pkOwner = actorUrl
+        , pkPublicKeyPem = details.pem
+        }
+    }
+
+instance A.ToJSON Actor where
+  toJSON actor =
+    A.object
+      [ "@context" A..=
+        [ "https://www.w3.org/ns/activitystreams" :: String
+        , "https://w3id.org/security/v1"
+        ]
+      , "id" A..= actor.actorId
+      , "type" A..= Person
+      , "name" A..= actor.actorName
+      , "preferredUsername" A..= actor.actorPreferredUsername
+      , "summary" A..= actor.actorSummary
+      , "icon" A..= A.object
+        [ "type" A..= ("Image" :: String)
+        , "mediaType" A..= ("image/png" :: String)
+        , "url" A..= actor.actorIcon
+        ]
+      , "inbox" A..= (actor.actorId <> "/inbox")
+      , "outbox" A..= (actor.actorId <> "/outbox")
+      , "publicKey" A..= actor.actorPublicKey
+      ]
+
+instance A.ToJSON ActorType where
+  toJSON Person = A.String "Person"
+
+instance A.ToJSON PublicKey where
+  toJSON pk =
+    A.object
+      [ "id" A..= pk.pkId
+      , "owner" A..= pk.pkOwner
+      , "publicKeyPem" A..= pk.pkPublicKeyPem
+      ]

src/Fedi/Routes.hs

@@ -0,0 +1,67 @@
+module Fedi.Routes where
+
+import Web.Twain qualified as Twain
+import Web.Twain.Types qualified as Twain
+import Data.String (fromString)
+import Data.Aeson qualified as A
+import Data.ByteString.Lazy qualified as BSL
+import Fedi.Types
+import Fedi.Activity
+import Fedi.Actor
+import Fedi.Webfinger
+
+-- * Routes
+
+routes :: UserDetails -> [Twain.Middleware]
+routes details =
+  [ Twain.get (matchUser details) do
+    handleUser details
+
+  , Twain.get (matchOutbox details) do
+    handleOutbox details
+
+  , Twain.get matchWebfinger do
+    handleWebfinger details
+  ]
+
+jsonLD :: BSL.ByteString -> Twain.Response
+jsonLD =
+  Twain.raw
+    Twain.status200
+    [(Twain.hContentType, "application/activity+json; charset=utf-8")]
+
+-- * User
+
+matchUser :: UserDetails -> Twain.PathPattern
+matchUser details = fromString ("/" <> details.username)
+
+handleUser :: UserDetails -> Twain.ResponderM a
+handleUser details = do
+  let content = makeActor details
+  Twain.send $ jsonLD (A.encode content)
+
+-- * Webfinger
+
+matchWebfinger :: Twain.PathPattern
+matchWebfinger = "/.well-known/webfinger"
+
+handleWebfinger :: UserDetails -> Twain.ResponderM b
+handleWebfinger details = do
+  resource <- Twain.param "resource"
+  let webfinger = makeWebfinger details
+  if resource == ppSubject webfinger.wfSubject
+    then do
+      Twain.send $ jsonLD (A.encode webfinger)
+    else do
+      Twain.next
+
+-- * Outbox
+
+matchOutbox :: UserDetails -> Twain.PathPattern
+matchOutbox details =
+  fromString ("/" <> details.username <> "/outbox")
+
+handleOutbox :: UserDetails -> Twain.ResponderM b
+handleOutbox details = do
+  let content = Collection { collectionSummary = details.username <> "'s notes", collectionItems = [] } :: Outbox
+  Twain.send $ jsonLD (A.encode content)

src/Fedi/Types.hs

@@ -0,0 +1,40 @@
+module Fedi.Types where
+
+import GHC.Generics (Generic)
+import Data.Aeson qualified as A
+import Data.Text qualified as T
+
+data Rel = Self
+  deriving Show
+
+instance A.ToJSON Rel where
+  toJSON Self = A.String "self"
+
+
+data LinkType = ActivityJson
+  deriving Show
+
+instance A.ToJSON LinkType where
+  toJSON ActivityJson = A.String "application/activity+json"
+
+type Url = String
+type Domain = String
+type Username = String
+
+newtype Pem = Pem T.Text
+  deriving Show
+  deriving A.FromJSON via T.Text
+
+instance A.ToJSON Pem where
+  toJSON (Pem pem) = A.String pem
+
+data UserDetails
+  = UserDetails
+    { domain :: Domain
+    , username :: String
+    , name :: String
+    , summary :: String
+    , icon :: Url
+    , pem :: Pem
+    }
+  deriving (Generic, A.FromJSON)

src/Fedi/Webfinger.hs

@@ -0,0 +1,72 @@
+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
+      ]