{-# OPTIONS_GHC -fno-warn-orphans #-}

module Data.Validity.ByteString where

import Data.Validity

import qualified Data.ByteString as SB
import qualified Data.ByteString.Internal as SB
import qualified Data.ByteString.Lazy as LB
import qualified Data.ByteString.Lazy.Internal as LB
import qualified Data.ByteString.Short as Short

-- | A 'ByteString' is NOT trivially valid.
--
-- The offset and the length both need to be positive.
-- Note that the length does not need to be greater than, or equal to, the offset.
--
-- TODO there's nothing we can do about the foreign pointer, I think?
instance Validity SB.ByteString where
    validate :: ByteString -> Validation
validate (SB.PS ForeignPtr Word8
_ Int
off Int
len) =
        [Validation] -> Validation
forall a. Monoid a => [a] -> a
mconcat
            [ String -> Int -> Validation
forall a. Validity a => String -> a -> Validation
delve String
"offset" Int
off
            , String -> Int -> Validation
forall a. Validity a => String -> a -> Validation
delve String
"length" Int
len
            , String -> Bool -> Validation
declare String
"The offset is positive" (Bool -> Validation) -> Bool -> Validation
forall a b. (a -> b) -> a -> b
$ Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
            , String -> Bool -> Validation
declare String
"The length is positive" (Bool -> Validation) -> Bool -> Validation
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
            ]

-- | A lazy 'ByteString' is valid according to its chunks.
instance Validity LB.ByteString where
    validate :: ByteString -> Validation
validate = Int -> ByteString -> Validation
go Int
0
      where
        go :: Int -> LB.ByteString -> Validation
        go :: Int -> ByteString -> Validation
go Int
_ ByteString
LB.Empty = Validation
valid
        go Int
i (LB.Chunk ByteString
sb ByteString
lb) =
            [Validation] -> Validation
forall a. Monoid a => [a] -> a
mconcat [String -> ByteString -> Validation
forall a. Validity a => String -> a -> Validation
delve ([String] -> String
unwords [String
"Chunk number", Int -> String
forall a. Show a => a -> String
show Int
i]) ByteString
sb, Int -> ByteString -> Validation
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
lb]

-- | Trivially valid
--
-- My guess is that short bytestrings are not trivially valid but there is no way to access the internals.
instance Validity Short.ShortByteString where
    validate :: ShortByteString -> Validation
validate = ShortByteString -> Validation
forall a. a -> Validation
trivialValidation