From 385e15fc22f48a1f8d40b8263a54155fdab499ea Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Wed, 17 Apr 2024 01:21:33 +0200
Subject: replace protocol-buffers with proto-lens

I do not really like either option, but at least the second one seems
more likely to be maintained (and a little less clunky to use, too, for
what it's worth).
---
 lib/API.hs | 33 ++++++++++++++++++++++++++-------
 1 file changed, 26 insertions(+), 7 deletions(-)

(limited to 'lib/API.hs')

diff --git a/lib/API.hs b/lib/API.hs
index 5ea1c06..b0e12f6 100644
--- a/lib/API.hs
+++ b/lib/API.hs
@@ -2,7 +2,9 @@
 {-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeApplications      #-}
 {-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE UndecidableInstances  #-}
 
 -- | The sole authorative definition of this server's API, given as a Servant-style
 -- Haskell type. All other descriptions of the API are generated from this one.
@@ -23,14 +25,16 @@ import           Data.Time                   (Day, UTCTime)
 import           Data.UUID                   (UUID)
 import           Servant                     (Application, FormUrlEncoded,
                                               FromHttpApiData (parseUrlPiece),
-                                              MimeRender (..), Server, err401,
+                                              MimeRender (..),
+                                              MimeUnrender (..), Server, err401,
                                               err404, type (:>))
-import           Servant.API                 (Capture, Get, JSON, MimeRender,
+import           Servant.API                 (Accept, Capture, Get, JSON,
+                                              MimeRender, MimeUnrender,
                                               NoContent, OctetStream, PlainText,
                                               Post, QueryParam, Raw, ReqBody,
                                               type (:<|>) (..))
 import           Servant.API.WebSocket       (WebSocket)
-import           Servant.GTFS.Realtime       (Proto)
+-- import           Servant.GTFS.Realtime       (Proto)
 import           Servant.Swagger             (HasSwagger (..))
 import           Web.Internal.FormUrlEncoded (Form)
 
@@ -38,14 +42,16 @@ import           Control.Lens                (At (at), (&), (?~))
 import           Data.Aeson                  (FromJSON (..), Value,
                                               genericParseJSON)
 import           Data.ByteString             (ByteString)
+import qualified Data.ByteString.Lazy        as LB
 import           Data.HashMap.Strict.InsOrd  (singleton)
+import           Data.ProtoLens              (Message, encodeMessage)
 import           GHC.Generics                (Generic)
 import           GTFS
-import           GTFS.Realtime.FeedEntity
-import           GTFS.Realtime.FeedMessage   (FeedMessage)
-import           Prometheus
-
+import           Network.HTTP.Media          ((//))
 import           Persist
+import           Prometheus
+import           Proto.GtfsRealtime          (FeedMessage)
+import           Servant.API.ContentTypes    (Accept (..))
 
 newtype RegisterJson = RegisterJson
   { registerAgent :: Text }
@@ -117,3 +123,16 @@ instance HasSwagger WebSocket where
       }
     }
 
+-- | A servant encoding for protobuf-encoded messages
+data Proto
+
+instance Accept Proto where
+  contentType _ = "application" // "octet-stream"
+
+instance Message msg => MimeRender Proto msg where
+  mimeRender _ = LB.fromStrict . encodeMessage
+
+-- TODO: this instance is horrible; ideally it should at least include
+-- the name of the message type (if at all possible)
+instance {-# OVERLAPPABLE #-} Message msg => ToSchema msg where
+  declareNamedSchema _ = declareNamedSchema (Proxy @String)
-- 
cgit v1.2.3