From f1697e5fd734ecb9208f18635e3350ce4d0784c9 Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Thu, 23 Jul 2020 16:24:45 +0200 Subject: [PATCH 1/2] re-structure post API, placeholder handlers contributes to #41, #32 --- src/Hash2Pub/FediChordTypes.hs | 2 +- src/Hash2Pub/PostService.hs | 67 ++++++++++++++++++++++++++++------ 2 files changed, 56 insertions(+), 13 deletions(-) diff --git a/src/Hash2Pub/FediChordTypes.hs b/src/Hash2Pub/FediChordTypes.hs index f1ca5b6..a91c369 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 5a8fc3a..5f51270 100644 --- a/src/Hash2Pub/PostService.hs +++ b/src/Hash2Pub/PostService.hs @@ -1,17 +1,60 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} module Hash2Pub.PostService where -import Servant -import qualified Data.Text as Txt +import Data.Maybe (fromMaybe) +import qualified Data.Text as Txt -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 +import Servant + +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 + +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 From c05544aa5b73916e740eff675692a3795a3f10b7 Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Thu, 23 Jul 2020 18:28:59 +0200 Subject: [PATCH 2/2] able to start a web server and run the mock API handlers contributes to #41, #32 --- Hash2Pub.cabal | 2 +- src/Hash2Pub/PostService.hs | 36 +++++++++++++++++++++++++++++++----- 2 files changed, 32 insertions(+), 6 deletions(-) diff --git a/Hash2Pub.cabal b/Hash2Pub.cabal index dba37a4..8a12e02 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 + 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 ghc-options: -Wall diff --git a/src/Hash2Pub/PostService.hs b/src/Hash2Pub/PostService.hs index 5f51270..652be25 100644 --- a/src/Hash2Pub/PostService.hs +++ b/src/Hash2Pub/PostService.hs @@ -1,13 +1,18 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} module Hash2Pub.PostService where -import Data.Maybe (fromMaybe) -import qualified Data.Text as Txt +import qualified Data.ByteString.Lazy.UTF8 as BSU +import Data.Maybe (fromMaybe) +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 @@ -37,6 +42,20 @@ postServer = relayInbox :<|> 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 @@ -58,3 +77,10 @@ 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