{-| Newtype for manipulating length-prefixed strings.

This type is for UTF-8 'Text' that you intend to write out to a length-prefixed
bytestring. The size of the length field is static. You essentially have to
decide the maximum bytesize of the string on creation.
-}

module StreamPatch.Patch.Binary.PascalText where

import           StreamPatch.Patch.Binary ( BinRep(..) )

import qualified Data.Text.Encoding         as Text
import           Data.Text                  ( Text )
import qualified Data.ByteString            as BS
import           GHC.TypeNats
import           Data.Proxy
import           Data.Bits

newtype PascalText (n :: Nat) = PascalText { forall (n :: Nat). PascalText n -> Text
unPascalText :: Text }

instance KnownNat n => BinRep (PascalText n) where
    toBinRep :: PascalText n -> Either String ByteString
toBinRep PascalText n
t =
        case PascalText n -> Maybe ByteString
forall (n :: Nat). KnownNat n => PascalText n -> Maybe ByteString
encodePascalText PascalText n
t of
          Maybe ByteString
Nothing -> String -> Either String ByteString
forall a b. a -> Either a b
Left String
"UTF-8 encoded text too long for length prefix field"
          Just ByteString
bs -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
bs

encodePascalText :: forall n. KnownNat n => PascalText n -> Maybe BS.ByteString
encodePascalText :: forall (n :: Nat). KnownNat n => PascalText n -> Maybe ByteString
encodePascalText PascalText n
t = do
    ByteString
lenBs <- Int -> Int -> Maybe ByteString
forall a. (Integral a, Bits a) => Int -> a -> Maybe ByteString
encodeToSizedBE (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy n -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @n))) (ByteString -> Int
BS.length ByteString
bs)
    ByteString -> Maybe ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
lenBs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs
  where
    bs :: ByteString
bs = Text -> ByteString
Text.encodeUtf8 (Text -> ByteString)
-> (PascalText n -> Text) -> PascalText n -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PascalText n -> Text
forall (n :: Nat). PascalText n -> Text
unPascalText (PascalText n -> ByteString) -> PascalText n -> ByteString
forall a b. (a -> b) -> a -> b
$ PascalText n
t

encodeToSizedBE :: (Integral a, Bits a) => Int -> a -> Maybe BS.ByteString
encodeToSizedBE :: forall a. (Integral a, Bits a) => Int -> a -> Maybe ByteString
encodeToSizedBE Int
byteSize a
x =
    let bs :: ByteString
bs = a -> ByteString
forall a. (Integral a, Bits a) => a -> ByteString
i2be a
x
        nulls :: Int
nulls = Int
byteSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
bs
     in if   Int
nulls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
        then Maybe ByteString
forall a. Maybe a
Nothing
        else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
BS.replicate Int
nulls Word8
0x00 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs

-- | Re-encode an 'Integer' to a little-endian integer stored as a
--   'BS.ByteString' using the fewest bytes needed to represent it.
--
-- adapated from crypto-api 0.13.3, Crypto.Util.i2bs_unsized
i2be :: (Integral a, Bits a) => a -> BS.ByteString
i2be :: forall a. (Integral a, Bits a) => a -> ByteString
i2be a
0 = Word8 -> ByteString
BS.singleton Word8
0
i2be a
i = ByteString -> ByteString
BS.reverse (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (a -> Maybe (Word8, a)) -> a -> ByteString
forall a. (a -> Maybe (Word8, a)) -> a -> ByteString
BS.unfoldr (\a
i' -> if a
i' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0 then Maybe (Word8, a)
forall a. Maybe a
Nothing else (Word8, a) -> Maybe (Word8, a)
forall a. a -> Maybe a
Just (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i', (a
i' a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
8))) a
i