diff --git a/Hash2Pub.cabal b/Hash2Pub.cabal index 8a12e02..dba37a4 100644 --- a/Hash2Pub.cabal +++ b/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 diff --git a/src/Hash2Pub/FediChordTypes.hs b/src/Hash2Pub/FediChordTypes.hs index a91c369..f1ca5b6 100644 --- a/src/Hash2Pub/FediChordTypes.hs +++ b/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) diff --git a/src/Hash2Pub/PostService.hs b/src/Hash2Pub/PostService.hs index 652be25..5a8fc3a 100644 --- a/src/Hash2Pub/PostService.hs +++ b/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