Hash2Pub.cabal

@@ -46,7 +46,7 @@ category:            Network
 extra-source-files:  CHANGELOG.md
 
 common deps
-  build-depends:       base ^>=4.12.0.0, containers ^>=0.6.0.1, bytestring, utf8-string ^>=1.0.1.1, network ^>=2.8.0.1, time ^>=1.8.0.2, cmdargs ^>= 0.10, cryptonite ^>= 0.25, memory, async, stm, asn1-encoding, asn1-types, asn1-parse, publicsuffix, network-byte-order, safe, iproute, mtl, random, servant, servant-server, servant-client, warp, text, http-api-data
+  build-depends:       base ^>=4.12.0.0, containers ^>=0.6.0.1, bytestring, utf8-string ^>=1.0.1.1, network ^>=2.8.0.1, time ^>=1.8.0.2, cmdargs ^>= 0.10, cryptonite ^>= 0.25, memory, async, stm, asn1-encoding, asn1-types, asn1-parse, publicsuffix, network-byte-order, safe, iproute, mtl, random, servant, servant-server, servant-client, warp, text
   ghc-options:         -Wall
 
 

src/Hash2Pub/FediChordTypes.hs

@@ -607,7 +607,7 @@ data FediChordConf = FediChordConf
     -- ^ list of potential bootstrapping nodes
     , confBootstrapSamplingInterval :: Int
     -- ^ pause between sampling the own ID through bootstrap nodes, in seconds
-    , confMaxLookupCacheAge         :: POSIXTime
+    , confMaxLookupCacheAge :: POSIXTime
     -- ^ maximum age of lookup cache entries in seconds
     }
     deriving (Show, Eq)

src/Hash2Pub/PostService.hs

@@ -1,86 +1,17 @@
-{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Hash2Pub.PostService where
 
-import qualified Data.ByteString.Lazy.UTF8 as BSU
-import           Data.Maybe                (fromMaybe)
-import qualified Data.Text                 as Txt
+import Servant
+import qualified Data.Text as Txt
 
-import qualified Network.Wai.Handler.Warp  as Warp
-import           Servant
-import           Web.HttpApiData           (showTextData)
-
-type PostServiceAPI = "relay" :> "inbox" :> ReqBody '[PlainText] Txt.Text :> PostCreated '[PlainText] Txt.Text
-                 -- ^ delivery endpoint of newly published posts of the relay's instance
-                 :<|> "relay" :> "subscribers" :> ReqBody '[PlainText] Txt.Text :> Post '[PlainText] Txt.Text
-                 -- ^ endpoint for delivering the subscriptions and outstanding queue
-                 :<|> "post" :> Capture "postid" Txt.Text :> Get '[PlainText] Txt.Text
-                 -- ^ fetch endpoint for posts, full post ID is http://$domain/post/$postid
-                 :<|> "posts" :> ReqBody '[PlainText] Txt.Text :> Post '[PlainText] Txt.Text
-                 -- ^ endpoint for fetching multiple posts at once
-                 :<|> "tags" :> Capture "hashtag" Txt.Text :> ReqBody '[PlainText] Txt.Text :> PostCreated '[PlainText] Txt.Text
-                 -- ^ delivery endpoint for posts of $tag at subscribing instance
-                 :<|> "tags" :> Capture "hashtag" Txt.Text :> "subscribe" :> Header "Origin" Txt.Text :> Get '[PlainText] Integer
-                 -- ^ endpoint for subscribing the instance specified in
-                 -- the Origin header to $hashtag.
-                 -- Returns subscription lease time in seconds.
-                 :<|> "tags" :> Capture "hashtag" Txt.Text :> "unsubscribe" :> Header "Origin" Txt.Text :> Get '[PlainText] Txt.Text
-                 -- ^ endpoint for unsubscribing the instance specified in
-                 -- the Origin header to $hashtag
-
-
-postServer :: Server PostServiceAPI
-postServer = relayInbox
-        :<|> subscriptionDelivery
-        :<|> postFetch
-        :<|> postMultiFetch
-        :<|> tagDelivery
-        :<|> tagSubscribe
-        :<|> tagUnsubscribe
-
-
--- | needed for guiding type inference
-exposedPostServiceAPI :: Proxy PostServiceAPI
-exposedPostServiceAPI = Proxy
-
--- | return a WAI application
-postServiceApplication :: Application
-postServiceApplication = serve exposedPostServiceAPI postServer
-
-servicePort = 8081
-
-runService :: IO ()
-runService = Warp.run servicePort postServiceApplication
-
-relayInbox :: Txt.Text -> Handler Txt.Text
-relayInbox post = pure $ "Here be InboxDragons with " <> post
-
-subscriptionDelivery :: Txt.Text -> Handler Txt.Text
-subscriptionDelivery subList = pure $ "Here be Subscription List dragons: " <> subList
-
-postFetch :: Txt.Text -> Handler Txt.Text
-postFetch postID = pure $ "Here be a post with dragon ID " <> postID
-
-postMultiFetch :: Txt.Text -> Handler Txt.Text
-postMultiFetch postIDs = pure $ "Here be multiple post dragons: "
-                      <> (Txt.unwords . Txt.lines $ postIDs)
-
-tagDelivery :: Txt.Text -> Txt.Text -> Handler Txt.Text
-tagDelivery hashtag posts = pure $ "Here be #" <> hashtag <> " dragons with " <> posts
-
-tagSubscribe :: Txt.Text -> Maybe Txt.Text -> Handler Integer
-tagSubscribe hashtag origin = pure 42
-
-tagUnsubscribe :: Txt.Text -> Maybe Txt.Text -> Handler Txt.Text
-tagUnsubscribe hashtag origin = pure $ "Here be a dragon unsubscription from " <> fromMaybe "Nothing" origin <> " to " <> hashtag
-
-
--- | define how to convert al showable types to PlainText
--- No idea what I'm doing with these overlappable instances though ¯\_(ツ)_/¯
--- TODO: figure out how this overlapping stuff actually works https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#instance-overlap
-instance {-# OVERLAPPABLE #-} Show a => MimeRender PlainText a where
-    mimeRender _ = BSU.fromString . show
+type ServiceAPI = "relay" :> "inbox" :> PostCreated '[PlainText] Txt.Text
+             -- ^ delivery endpoint of new posts to relay 
+             :<|> "relay" :> "subscribers" :> Post '[PlainText] Txt.Text
+             -- ^ endpoint for delivering the subscription and outstanding queue 
+             :<|> "post" :> Capture "postid" Txt.Text :> Get '[PlainText] Txt.Text
+             :<|> "tags" :> Capture "hashtag" Txt.Text :> PostCreated '[PlainText] Txt.Text
+             :<|> "tags" :> Capture "hashtag" Txt.Text :> "subscribe" :> Header "Origin" Txt.Text :> Get '[PlainText] Txt.Text
+             :<|> "tags" :> Capture "hashtag" Txt.Text :> "unsubscribe" :> Header "Origin" Txt.Text :> Get '[PlainText] Txt.Text