From c05544aa5b73916e740eff675692a3795a3f10b7 Mon Sep 17 00:00:00 2001
From: Trolli Schmittlauch <t.schmittlauch@orlives.de>
Date: Thu, 23 Jul 2020 18:28:59 +0200
Subject: [PATCH] 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