refactor Fedi.Routes

fedi.cabal

@@ -18,10 +18,17 @@ library
   exposed-modules:
     Fedi
     Fedi.Helpers
-    Fedi.Routes
     Fedi.Types
     Fedi.UserDetails
     Fedi.Webfinger
+
+    Fedi.Routes
+    Fedi.Routes.Helpers
+    Fedi.Routes.User
+    Fedi.Routes.Inbox
+    Fedi.Routes.Outbox
+    Fedi.Routes.Notes
+    Fedi.Routes.Follow
   -- other-modules:
   -- other-extensions:
   build-depends:

src/Fedi/Routes.hs

@@ -1,14 +1,18 @@
-module Fedi.Routes where
+module Fedi.Routes
+  ( module Fedi.Routes
+  , module Export
+  )
+where
 
-import Data.Aeson qualified as A
-import Data.ByteString qualified as BS
-import Data.ByteString.Lazy qualified as BSL
-import Fedi.Helpers
-import Fedi.Types
 import Fedi.UserDetails
-import Fedi.Webfinger
 import Web.Twain qualified as Twain
-import Web.Twain.Types qualified as Twain
+
+import Fedi.Routes.Helpers as Export
+import Fedi.Routes.User as Export
+import Fedi.Routes.Inbox as Export
+import Fedi.Routes.Outbox as Export
+import Fedi.Routes.Notes as Export
+import Fedi.Routes.Follow as Export
 
 -- * Routes
 
@@ -29,194 +33,3 @@ routes 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")]
-
--- * Create
-
-matchCreateNote :: UserDetails -> Twain.PathPattern
-matchCreateNote details = fromString ("/" <> details.username <> "/notes/:note_id/create")
-
-handleCreateNote :: UserDetails -> [Create] -> Twain.ResponderM a
-handleCreateNote details items = do
-  noteId <- Twain.param "note_id"
-  let
-    createUrl =
-      "https://"
-        <> details.domain
-        <> "/"
-        <> details.username
-        <> "/notes/"
-        <> noteId
-        <> "/create"
-  let
-    content =
-      find (\create -> create.id == Just (ObjectId createUrl)) items
-  Twain.send $ jsonLD (A.encode content)
-
--- * Note
-
-matchNote :: UserDetails -> Twain.PathPattern
-matchNote details = fromString ("/" <> details.username <> "/notes/:note_id")
-
-handleNote :: UserDetails -> [Note] -> Twain.ResponderM a
-handleNote details items = do
-  noteId <- Twain.param "note_id"
-  let
-    noteUrl =
-      "https://"
-        <> details.domain
-        <> "/"
-        <> details.username
-        <> "/notes/"
-        <> noteId
-  let
-    content =
-      find (\note -> note.id == Just (ObjectId noteUrl)) items
-  Twain.send $ jsonLD (A.encode content)
-
--- * 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.subject
-    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 -> [AnyActivity] -> Twain.ResponderM b
-handleOutbox details items = do
-  isPage <- Twain.queryParamMaybe "page"
-  let
-    outboxUrl =
-      "https://"
-        <> details.domain
-        <> "/"
-        <> details.username
-        <> "/outbox"
-    response =
-      case isPage of
-        Just True ->
-          let
-            empty = emptyOrderedCollectionPage outboxUrl
-            content :: OutboxPage
-            content =
-              empty
-                { id = Just $ ObjectId $ outboxUrl <> "?page=true"
-                , otype =
-                    empty.otype
-                      { ctype =
-                          empty.otype.ctype
-                            { partOf = outboxUrl
-                            , porderedItems = items
-                            }
-                      }
-                }
-          in
-            A.encode content
-        _ ->
-          let
-            content :: Outbox
-            content =
-              emptyOrderedCollection
-                { id = Just $ ObjectId outboxUrl
-                , summary = Just $ fromString $ details.username <> "'s notes"
-                , otype =
-                    emptyOrderedCollection.otype
-                      { ctype =
-                          emptyOrderedCollection.otype.ctype
-                            { orderedItems = items
-                            }
-                      , first = Just $ outboxUrl <> "?page=true"
-                      , last = Just $ outboxUrl <> "?page=true"
-                      }
-                }
-          in
-            A.encode content
-  Twain.send $ jsonLD response
-
--- * Inbox
-
-matchInbox :: UserDetails -> Twain.PathPattern
-matchInbox details =
-  fromString ("/" <> details.username <> "/inbox")
-
-handleInbox :: (AnyActivity -> Twain.ResponderM Twain.Response) -> Twain.ResponderM b
-handleInbox handle = do
-  activity <- Twain.fromBody
-  response <- handle activity
-  Twain.send response
-
--- * Followers
-
-matchFollowers :: UserDetails -> Twain.PathPattern
-matchFollowers details =
-  fromString ("/" <> details.username <> "/followers")
-
-handleFollowers :: UserDetails -> Twain.ResponderM b
-handleFollowers details = do
-  let
-    collection :: Collection ()
-    collection =
-      emptyUnorderedCollection
-      { id = Just $ ObjectId $ actorUrl details <> "/followers"
-      , summary = Just $ fromString $ details.username <> "'s followers"
-      }
-  Twain.send $ jsonLD (A.encode collection)
-
--- * Following
-
-matchFollowing :: UserDetails -> Twain.PathPattern
-matchFollowing details =
-  fromString ("/" <> details.username <> "/following")
-
-handleFollowing :: UserDetails -> Twain.ResponderM b
-handleFollowing details = do
-  let
-    collection :: Collection ()
-    collection =
-      emptyUnorderedCollection
-      { id = Just $ ObjectId $ actorUrl details <> "/following"
-      , summary = Just $ fromString $ details.username <> " is following"
-      }
-  Twain.send $ jsonLD (A.encode collection)
-
--- * Other stuff
-
-checkContentTypeAccept :: Twain.Request -> Bool
-checkContentTypeAccept request =
-  case lookup Twain.hAccept request.requestHeaders of
-    Just bs ->
-      ("application/activity+json" `BS.isInfixOf` bs)
-        || ( ("application/ld+json" `BS.isInfixOf` bs)
-              && ("profile=\"https://www.w3.org/ns/activitystreams\"" `BS.isInfixOf` bs)
-           )
-    Nothing -> False

src/Fedi/Routes/Follow.hs

@@ -0,0 +1,43 @@
+module Fedi.Routes.Follow where
+
+import Data.Aeson qualified as A
+import Fedi.Helpers
+import Fedi.Types
+import Fedi.UserDetails
+import Fedi.Routes.Helpers
+import Web.Twain qualified as Twain
+import Web.Twain.Types qualified as Twain
+
+-- * Followers
+
+matchFollowers :: UserDetails -> Twain.PathPattern
+matchFollowers details =
+  fromString ("/" <> details.username <> "/followers")
+
+handleFollowers :: UserDetails -> Twain.ResponderM b
+handleFollowers details = do
+  let
+    collection :: Collection ()
+    collection =
+      emptyUnorderedCollection
+      { id = Just $ ObjectId $ actorUrl details <> "/followers"
+      , summary = Just $ fromString $ details.username <> "'s followers"
+      }
+  Twain.send $ jsonLD (A.encode collection)
+
+-- * Following
+
+matchFollowing :: UserDetails -> Twain.PathPattern
+matchFollowing details =
+  fromString ("/" <> details.username <> "/following")
+
+handleFollowing :: UserDetails -> Twain.ResponderM b
+handleFollowing details = do
+  let
+    collection :: Collection ()
+    collection =
+      emptyUnorderedCollection
+      { id = Just $ ObjectId $ actorUrl details <> "/following"
+      , summary = Just $ fromString $ details.username <> " is following"
+      }
+  Twain.send $ jsonLD (A.encode collection)

src/Fedi/Routes/Helpers.hs

@@ -0,0 +1,21 @@
+module Fedi.Routes.Helpers where
+
+import Data.ByteString qualified as BS
+import Data.ByteString.Lazy qualified as BSL
+import Web.Twain qualified as Twain
+
+jsonLD :: BSL.ByteString -> Twain.Response
+jsonLD =
+  Twain.raw
+    Twain.status200
+    [(Twain.hContentType, "application/activity+json; charset=utf-8")]
+
+checkContentTypeAccept :: Twain.Request -> Bool
+checkContentTypeAccept request =
+  case lookup Twain.hAccept request.requestHeaders of
+    Just bs ->
+      ("application/activity+json" `BS.isInfixOf` bs)
+        || ( ("application/ld+json" `BS.isInfixOf` bs)
+              && ("profile=\"https://www.w3.org/ns/activitystreams\"" `BS.isInfixOf` bs)
+           )
+    Nothing -> False

src/Fedi/Routes/Inbox.hs

@@ -0,0 +1,19 @@
+module Fedi.Routes.Inbox where
+
+import Fedi.Types
+import Fedi.UserDetails
+import Web.Twain qualified as Twain
+import Web.Twain.Types qualified as Twain
+
+-- * Inbox
+
+matchInbox :: UserDetails -> Twain.PathPattern
+matchInbox details =
+  fromString ("/" <> details.username <> "/inbox")
+
+handleInbox :: (AnyActivity -> Twain.ResponderM Twain.Response) -> Twain.ResponderM b
+handleInbox handle = do
+  activity <- Twain.fromBody
+  -- sig <- Twain.header "Signature"
+  response <- handle activity
+  Twain.send response

src/Fedi/Routes/Notes.hs

@@ -0,0 +1,51 @@
+module Fedi.Routes.Notes where
+
+import Data.Aeson qualified as A
+import Fedi.Types
+import Fedi.UserDetails
+import Fedi.Routes.Helpers
+import Web.Twain qualified as Twain
+import Web.Twain.Types qualified as Twain
+
+-- * Create
+
+matchCreateNote :: UserDetails -> Twain.PathPattern
+matchCreateNote details = fromString ("/" <> details.username <> "/notes/:note_id/create")
+
+handleCreateNote :: UserDetails -> [Create] -> Twain.ResponderM a
+handleCreateNote details items = do
+  noteId <- Twain.param "note_id"
+  let
+    createUrl =
+      "https://"
+        <> details.domain
+        <> "/"
+        <> details.username
+        <> "/notes/"
+        <> noteId
+        <> "/create"
+  let
+    content =
+      find (\create -> create.id == Just (ObjectId createUrl)) items
+  Twain.send $ jsonLD (A.encode content)
+
+-- * Note
+
+matchNote :: UserDetails -> Twain.PathPattern
+matchNote details = fromString ("/" <> details.username <> "/notes/:note_id")
+
+handleNote :: UserDetails -> [Note] -> Twain.ResponderM a
+handleNote details items = do
+  noteId <- Twain.param "note_id"
+  let
+    noteUrl =
+      "https://"
+        <> details.domain
+        <> "/"
+        <> details.username
+        <> "/notes/"
+        <> noteId
+  let
+    content =
+      find (\note -> note.id == Just (ObjectId noteUrl)) items
+  Twain.send $ jsonLD (A.encode content)

src/Fedi/Routes/Outbox.hs

@@ -0,0 +1,66 @@
+module Fedi.Routes.Outbox where
+
+import Data.Aeson qualified as A
+import Fedi.Helpers
+import Fedi.Types
+import Fedi.UserDetails
+import Fedi.Routes.Helpers
+import Web.Twain qualified as Twain
+import Web.Twain.Types qualified as Twain
+
+-- * Outbox
+
+matchOutbox :: UserDetails -> Twain.PathPattern
+matchOutbox details =
+  fromString ("/" <> details.username <> "/outbox")
+
+handleOutbox :: UserDetails -> [AnyActivity] -> Twain.ResponderM b
+handleOutbox details items = do
+  isPage <- Twain.queryParamMaybe "page"
+  let
+    outboxUrl =
+      "https://"
+        <> details.domain
+        <> "/"
+        <> details.username
+        <> "/outbox"
+    response =
+      case isPage of
+        Just True ->
+          let
+            empty = emptyOrderedCollectionPage outboxUrl
+            content :: OutboxPage
+            content =
+              empty
+                { id = Just $ ObjectId $ outboxUrl <> "?page=true"
+                , otype =
+                    empty.otype
+                      { ctype =
+                          empty.otype.ctype
+                            { partOf = outboxUrl
+                            , porderedItems = items
+                            }
+                      }
+                }
+          in
+            A.encode content
+        _ ->
+          let
+            content :: Outbox
+            content =
+              emptyOrderedCollection
+                { id = Just $ ObjectId outboxUrl
+                , summary = Just $ fromString $ details.username <> "'s notes"
+                , otype =
+                    emptyOrderedCollection.otype
+                      { ctype =
+                          emptyOrderedCollection.otype.ctype
+                            { orderedItems = items
+                            }
+                      , first = Just $ outboxUrl <> "?page=true"
+                      , last = Just $ outboxUrl <> "?page=true"
+                      }
+                }
+          in
+            A.encode content
+  Twain.send $ jsonLD response

src/Fedi/Routes/User.hs

@@ -0,0 +1,36 @@
+module Fedi.Routes.User where
+
+import Data.Aeson qualified as A
+import Fedi.Helpers
+import Fedi.UserDetails
+import Fedi.Webfinger
+import Fedi.Routes.Helpers
+import Web.Twain qualified as Twain
+import Web.Twain.Types qualified as Twain
+
+-- * 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.subject
+    then do
+      Twain.send $ jsonLD (A.encode webfinger)
+    else do
+      Twain.next