able to start a web server and run the mock API handlers
contributes to #41, #32
This commit is contained in:
parent
f1697e5fd7
commit
c05544aa5b
|
@ -46,7 +46,7 @@ category: Network
|
||||||
extra-source-files: CHANGELOG.md
|
extra-source-files: CHANGELOG.md
|
||||||
|
|
||||||
common deps
|
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
|
ghc-options: -Wall
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1,13 +1,18 @@
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
|
||||||
module Hash2Pub.PostService where
|
module Hash2Pub.PostService where
|
||||||
|
|
||||||
|
import qualified Data.ByteString.Lazy.UTF8 as BSU
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import qualified Data.Text as Txt
|
import qualified Data.Text as Txt
|
||||||
|
|
||||||
|
import qualified Network.Wai.Handler.Warp as Warp
|
||||||
import Servant
|
import Servant
|
||||||
|
import Web.HttpApiData (showTextData)
|
||||||
|
|
||||||
type PostServiceAPI = "relay" :> "inbox" :> ReqBody '[PlainText] Txt.Text :> PostCreated '[PlainText] Txt.Text
|
type PostServiceAPI = "relay" :> "inbox" :> ReqBody '[PlainText] Txt.Text :> PostCreated '[PlainText] Txt.Text
|
||||||
-- ^ delivery endpoint of newly published posts of the relay's instance
|
-- ^ delivery endpoint of newly published posts of the relay's instance
|
||||||
|
@ -37,6 +42,20 @@ postServer = relayInbox
|
||||||
:<|> tagSubscribe
|
:<|> tagSubscribe
|
||||||
:<|> tagUnsubscribe
|
:<|> 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 :: Txt.Text -> Handler Txt.Text
|
||||||
relayInbox post = pure $ "Here be InboxDragons with " <> post
|
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 :: Txt.Text -> Maybe Txt.Text -> Handler Txt.Text
|
||||||
tagUnsubscribe hashtag origin = pure $ "Here be a dragon unsubscription from " <> fromMaybe "Nothing" origin <> " to " <> hashtag
|
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
|
||||||
|
|
Loading…
Reference in a new issue