-- | Wire encodings of the client API: JSON (the default) or native CBOR.
--
-- This module is the single home for the encode/decode primitives shared by
-- the WebSocket server, the HTTP server and the clients; call sites resolve
-- the negotiated 'ApiEncoding' once and stay dispatch-free afterwards.
module Hydra.API.WireFormat where

import Hydra.Prelude

import Cardano.Binary (decodeFull', serialize')
import Data.Aeson qualified as Aeson
import Data.ByteString.Lazy qualified as LBS

-- | Which wire encoding a client negotiated: JSON (the default) or native
-- CBOR. WebSocket clients opt in via the @?encoding=cbor@ query parameter,
-- HTTP clients via @Accept@ / @Content-Type: application/cbor@ headers.
data ApiEncoding = JsonEncoding | CborEncoding
  deriving stock (ApiEncoding -> ApiEncoding -> Bool
(ApiEncoding -> ApiEncoding -> Bool)
-> (ApiEncoding -> ApiEncoding -> Bool) -> Eq ApiEncoding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApiEncoding -> ApiEncoding -> Bool
== :: ApiEncoding -> ApiEncoding -> Bool
$c/= :: ApiEncoding -> ApiEncoding -> Bool
/= :: ApiEncoding -> ApiEncoding -> Bool
Eq, Int -> ApiEncoding -> ShowS
[ApiEncoding] -> ShowS
ApiEncoding -> String
(Int -> ApiEncoding -> ShowS)
-> (ApiEncoding -> String)
-> ([ApiEncoding] -> ShowS)
-> Show ApiEncoding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApiEncoding -> ShowS
showsPrec :: Int -> ApiEncoding -> ShowS
$cshow :: ApiEncoding -> String
show :: ApiEncoding -> String
$cshowList :: [ApiEncoding] -> ShowS
showList :: [ApiEncoding] -> ShowS
Show)

-- | Encode a value in the given wire encoding.
encodeWire :: (ToJSON a, ToCBOR a) => ApiEncoding -> a -> LBS.ByteString
encodeWire :: forall a. (ToJSON a, ToCBOR a) => ApiEncoding -> a -> ByteString
encodeWire = \case
  ApiEncoding
JsonEncoding -> a -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode
  ApiEncoding
CborEncoding -> ByteString -> ByteString
forall l s. LazyStrict l s => s -> l
fromStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize'

-- | Decode a value in the given wire encoding.
decodeWire :: (FromJSON a, FromCBOR a) => ApiEncoding -> LBS.ByteString -> Either String a
decodeWire :: forall a.
(FromJSON a, FromCBOR a) =>
ApiEncoding -> ByteString -> Either String a
decodeWire = \case
  ApiEncoding
JsonEncoding -> ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode'
  ApiEncoding
CborEncoding -> (DecoderError -> String)
-> Either DecoderError a -> Either String a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DecoderError -> String
forall b a. (Show a, IsString b) => a -> b
show (Either DecoderError a -> Either String a)
-> (ByteString -> Either DecoderError a)
-> ByteString
-> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either DecoderError a
forall a. FromCBOR a => ByteString -> Either DecoderError a
decodeFull' (ByteString -> Either DecoderError a)
-> (ByteString -> ByteString)
-> ByteString
-> Either DecoderError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict

-- | Echo received bytes in a readable form: raw text for JSON, base16 for
-- CBOR (which is not valid UTF-8).
describeWire :: ApiEncoding -> LBS.ByteString -> Text
describeWire :: ApiEncoding -> ByteString -> Text
describeWire = \case
  ApiEncoding
JsonEncoding -> OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict
  ApiEncoding
CborEncoding -> ByteString -> Text
encodeBase16 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict