module Ouroboros.Network.Protocol.Codec.Utils
  ( WithBytes (..)
  , encodeBytes
  , encodeWithBytes
  , WithByteSpan (..)
  , decodeWithByteSpan
  , bytesBetweenOffsets
  , runWithByteSpan
  ) where

import Codec.CBOR.Decoding qualified as CBOR
import Codec.CBOR.Encoding qualified as CBOR
import Data.ByteString.Lazy (ByteString)
import Data.ByteString.Lazy qualified as BSL


data WithBytes a = WithBytes {
      forall a. WithBytes a -> ByteString
cborBytes   :: ByteString,
      -- ^ cbor encoding
      forall a. WithBytes a -> a
cborPayload :: a
      -- ^ decoded structure
    }
  deriving (Int -> WithBytes a -> ShowS
[WithBytes a] -> ShowS
WithBytes a -> String
(Int -> WithBytes a -> ShowS)
-> (WithBytes a -> String)
-> ([WithBytes a] -> ShowS)
-> Show (WithBytes a)
forall a. Show a => Int -> WithBytes a -> ShowS
forall a. Show a => [WithBytes a] -> ShowS
forall a. Show a => WithBytes a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> WithBytes a -> ShowS
showsPrec :: Int -> WithBytes a -> ShowS
$cshow :: forall a. Show a => WithBytes a -> String
show :: WithBytes a -> String
$cshowList :: forall a. Show a => [WithBytes a] -> ShowS
showList :: [WithBytes a] -> ShowS
Show, WithBytes a -> WithBytes a -> Bool
(WithBytes a -> WithBytes a -> Bool)
-> (WithBytes a -> WithBytes a -> Bool) -> Eq (WithBytes a)
forall a. Eq a => WithBytes a -> WithBytes a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => WithBytes a -> WithBytes a -> Bool
== :: WithBytes a -> WithBytes a -> Bool
$c/= :: forall a. Eq a => WithBytes a -> WithBytes a -> Bool
/= :: WithBytes a -> WithBytes a -> Bool
Eq)

encodeBytes :: ByteString -> CBOR.Encoding
encodeBytes :: ByteString -> Encoding
encodeBytes =
    -- this should be equivalent to
    -- `CBOR.encodePreEncoded . BSL.toStrict . cborBytes`
    -- but it doesn't copy the bytes
    (ByteString -> Encoding) -> [ByteString] -> Encoding
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ByteString -> Encoding
CBOR.encodePreEncoded ([ByteString] -> Encoding)
-> (ByteString -> [ByteString]) -> ByteString -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BSL.toChunks

encodeWithBytes :: WithBytes a -> CBOR.Encoding
encodeWithBytes :: forall a. WithBytes a -> Encoding
encodeWithBytes = ByteString -> Encoding
encodeBytes (ByteString -> Encoding)
-> (WithBytes a -> ByteString) -> WithBytes a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithBytes a -> ByteString
forall a. WithBytes a -> ByteString
cborBytes

-- | A bytespan functor.
--
newtype WithByteSpan a = WithByteSpan (a, CBOR.ByteOffset, CBOR.ByteOffset)

decodeWithByteSpan :: CBOR.Decoder s a -> CBOR.Decoder s (WithByteSpan a)
decodeWithByteSpan :: forall s a. Decoder s a -> Decoder s (WithByteSpan a)
decodeWithByteSpan = ((a, Int64, Int64) -> WithByteSpan a)
-> Decoder s (a, Int64, Int64) -> Decoder s (WithByteSpan a)
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Int64, Int64) -> WithByteSpan a
forall a. (a, Int64, Int64) -> WithByteSpan a
WithByteSpan (Decoder s (a, Int64, Int64) -> Decoder s (WithByteSpan a))
-> (Decoder s a -> Decoder s (a, Int64, Int64))
-> Decoder s a
-> Decoder s (WithByteSpan a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoder s a -> Decoder s (a, Int64, Int64)
forall s a. Decoder s a -> Decoder s (a, Int64, Int64)
CBOR.decodeWithByteSpan

bytesBetweenOffsets :: CBOR.ByteOffset -> CBOR.ByteOffset -> ByteString -> ByteString
bytesBetweenOffsets :: Int64 -> Int64 -> ByteString -> ByteString
bytesBetweenOffsets Int64
start Int64
end ByteString
bytes = Int64 -> ByteString -> ByteString
BSL.take (Int64
end Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
start) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BSL.drop Int64
start ByteString
bytes

runWithByteSpan :: ByteString -> WithByteSpan (ByteString -> a) -> WithBytes a
runWithByteSpan :: forall a.
ByteString -> WithByteSpan (ByteString -> a) -> WithBytes a
runWithByteSpan ByteString
bytes (WithByteSpan (ByteString -> a
a, Int64
start, Int64
end)) = WithBytes {
    cborBytes :: ByteString
cborBytes   = Int64 -> Int64 -> ByteString -> ByteString
bytesBetweenOffsets Int64
start Int64
end ByteString
bytes,
    cborPayload :: a
cborPayload = ByteString -> a
a ByteString
bytes
  }