{- | Machine bytestrings.

I mix string and bytestring terminology here due to bad C influences, but this
module is specifically interested in bytestrings and their encoding. String/text
encoding is handled in another module.

Note that the length prefix predicate is also defined here... because that's
just Pascal-style bytestrings, extended to other types. I can't easily put it in
an orphan module, because we define byte length for *all length-prefixed types*
in one fell swoop.
-}

-- TODO redocument. pretty all over the place

{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings #-}

module Binrep.Type.ByteString where

import Binrep
import Binrep.Type.Common ( Endianness )
import Binrep.Type.Int
import Binrep.Util

import Refined
import Refined.Unsafe

import Data.ByteString qualified as B
import FlatParse.Basic qualified as FP
import Data.Word ( Word8 )
import GHC.TypeNats ( KnownNat )

import GHC.Generics ( Generic )
import Data.Data ( Data )

import Data.Typeable ( Typeable, typeRep )

-- | Bytestring representation.
data Rep
  = C
  -- ^ C-style bytestring. Arbitrary length, terminated with a null byte.
  --   Permits no null bytes inside the bytestring.

  | Pascal ISize Endianness
  -- ^ Pascal-style bytestring. Length defined in a prefixing integer of given
  --   size and endianness.
    deriving stock (forall x. Rep Rep x -> Rep
forall x. Rep -> Rep Rep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Rep x -> Rep
$cfrom :: forall x. Rep -> Rep Rep x
Generic, Typeable Rep
Rep -> DataType
Rep -> Constr
(forall b. Data b => b -> b) -> Rep -> Rep
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Rep -> u
forall u. (forall d. Data d => d -> u) -> Rep -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Rep -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Rep -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Rep -> m Rep
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rep -> m Rep
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Rep
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rep -> c Rep
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Rep)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Rep)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rep -> m Rep
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rep -> m Rep
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rep -> m Rep
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rep -> m Rep
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Rep -> m Rep
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Rep -> m Rep
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Rep -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Rep -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Rep -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Rep -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Rep -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Rep -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Rep -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Rep -> r
gmapT :: (forall b. Data b => b -> b) -> Rep -> Rep
$cgmapT :: (forall b. Data b => b -> b) -> Rep -> Rep
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Rep)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Rep)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Rep)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Rep)
dataTypeOf :: Rep -> DataType
$cdataTypeOf :: Rep -> DataType
toConstr :: Rep -> Constr
$ctoConstr :: Rep -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Rep
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Rep
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rep -> c Rep
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rep -> c Rep
Data, Int -> Rep -> ShowS
[Rep] -> ShowS
Rep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rep] -> ShowS
$cshowList :: [Rep] -> ShowS
show :: Rep -> String
$cshow :: Rep -> String
showsPrec :: Int -> Rep -> ShowS
$cshowsPrec :: Int -> Rep -> ShowS
Show, Rep -> Rep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rep -> Rep -> Bool
$c/= :: Rep -> Rep -> Bool
== :: Rep -> Rep -> Bool
$c== :: Rep -> Rep -> Bool
Eq)

-- | A bytestring using the given representation, stored in the 'Text' type.
type AsByteString (rep :: Rep) = Refined rep B.ByteString

getCString :: Getter B.ByteString
getCString :: Getter ByteString
getCString = forall e a. Parser e a -> e -> Parser e a
FP.cut forall e. Parser e ByteString
FP.anyCString forall a b. (a -> b) -> a -> b
$ EBase -> E
EBase forall a b. (a -> b) -> a -> b
$ String -> EBase
EFailNamed String
"cstring"

instance BLen (AsByteString 'C) where
    blen :: AsByteString 'C -> Int
blen AsByteString 'C
cbs = forall a. AsBLen a => Int -> a
posIntToBLen forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length (forall {k} (p :: k) x. Refined p x -> x
unrefine AsByteString 'C
cbs) forall a. Num a => a -> a -> a
+ Int
1

instance Put (AsByteString 'C) where
    put :: AsByteString 'C -> Builder
put = ByteString -> Builder
putCString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (p :: k) x. Refined p x -> x
unrefine

putCString :: B.ByteString -> Builder
putCString :: ByteString -> Builder
putCString ByteString
bs = forall a. Put a => a -> Builder
put ByteString
bs forall a. Semigroup a => a -> a -> a
<> forall a. Put a => a -> Builder
put @Word8 Word8
0x00

instance Get (AsByteString 'C) where
    get :: Getter (AsByteString 'C)
get = forall {k} x (p :: k). x -> Refined p x
reallyUnsafeRefine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getter ByteString
getCString

instance (itype ~ I 'U size end, irep ~ IRep 'U size, KnownNat (CBLen irep)) => BLen (AsByteString ('Pascal size end)) where
    blen :: AsByteString ('Pascal size end) -> Int
blen AsByteString ('Pascal size end)
pbs = forall a (n :: Natural). (n ~ CBLen a, KnownNat n) => Int
cblen @itype forall a. Num a => a -> a -> a
+ forall a. BLen a => a -> Int
blen (forall {k} (p :: k) x. Refined p x -> x
unrefine AsByteString ('Pascal size end)
pbs)

instance (itype ~ I 'U size end, irep ~ IRep 'U size, Put itype, Num irep) => Put (AsByteString ('Pascal size end)) where
    put :: AsByteString ('Pascal size end) -> Builder
put AsByteString ('Pascal size end)
pbs = forall a. Put a => a -> Builder
put @itype (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs)) forall a. Semigroup a => a -> a -> a
<> forall a. Put a => a -> Builder
put ByteString
bs
      where bs :: ByteString
bs = forall {k} (p :: k) x. Refined p x -> x
unrefine AsByteString ('Pascal size end)
pbs

instance (itype ~ I 'U size end, irep ~ IRep 'U size, Integral irep, Get itype) => Get (AsByteString ('Pascal size end)) where
    get :: Getter (AsByteString ('Pascal size end))
get = do
        itype
len <- forall a. Get a => Getter a
get @itype
        ByteString
bs <- forall e. Int -> Parser e ByteString
FP.takeBs forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral itype
len
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {k} x (p :: k). x -> Refined p x
reallyUnsafeRefine ByteString
bs

-- | A C-style bytestring must not contain any null bytes.
instance Predicate 'C B.ByteString where
    validate :: Proxy 'C -> ByteString -> Maybe RefineException
validate Proxy 'C
p ByteString
bs
     | (Word8 -> Bool) -> ByteString -> Bool
B.any (forall a. Eq a => a -> a -> Bool
== Word8
0x00) ByteString
bs = TypeRep -> Text -> Maybe RefineException
throwRefineOtherException (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy 'C
p) forall a b. (a -> b) -> a -> b
$
        Text
"null byte not permitted in in C-style bytestring"
     | Bool
otherwise = Maybe RefineException
success

instance
    ( irep ~ IRep 'U size
    , Bounded irep, Integral irep
    , Show irep, Typeable size, Typeable e
    ) => Predicate ('Pascal size e) B.ByteString where
    validate :: Proxy ('Pascal size e) -> ByteString -> Maybe RefineException
validate Proxy ('Pascal size e)
p ByteString
bs
     | Int
len forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral irep
max'
        = TypeRep -> Text -> Maybe RefineException
throwRefineOtherException (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy ('Pascal size e)
p) forall a b. (a -> b) -> a -> b
$
              Text
"bytestring too long for given length prefix type: "
            forall a. Semigroup a => a -> a -> a
<>forall a. Show a => a -> Text
tshow Int
lenforall a. Semigroup a => a -> a -> a
<>Text
" > "forall a. Semigroup a => a -> a -> a
<>forall a. Show a => a -> Text
tshow irep
max'
     | Bool
otherwise = Maybe RefineException
success
      where
        len :: Int
len  = ByteString -> Int
B.length ByteString
bs
        max' :: irep
max' = forall a. Bounded a => a
maxBound @irep