diff options
author | stuebinm | 2024-04-17 01:21:33 +0200 |
---|---|---|
committer | stuebinm | 2024-04-17 01:48:35 +0200 |
commit | 385e15fc22f48a1f8d40b8263a54155fdab499ea (patch) | |
tree | 19f3a8b3fcb017eebdba3f094ceb5ff80c6c0134 /lib/API.hs | |
parent | a995dabf07574a32c1ae62ad23b96ba7d8e076ee (diff) |
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).
Diffstat (limited to 'lib/API.hs')
-rw-r--r-- | lib/API.hs | 33 |
1 files changed, 26 insertions, 7 deletions
@@ -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) |