-- | Internal module. Not part of the public API.
module Database.Bolty.Util
  ( chunksOfBSL
  , chunksOfBS
  , putTextUtf8
  , decodeStrict
  , encodeStrict
  , lazyByteStringToHex
  , whenInvalid
  ) where

import           Control.Exception.Extra          (Partial)
import           Data.ByteString.Builder          (toLazyByteString, lazyByteStringHex)
import           Data.Int                         (Int64)
import           Data.List.Split                  (chunksOf)
import           Data.Persist                     (Put, HasEndianness, putByteString, runPut, runGet, putBE, getBE)
import           Data.Word8                       (toUpper)
import qualified Data.ByteString                  as BS
import qualified Data.ByteString.Lazy             as BSL
import qualified Data.Text                        as T
import qualified Data.Text.Encoding               as T
import qualified Validation                       as V


-- | Split a lazy 'BSL.ByteString' into chunks of at most @n@ bytes.
chunksOfBSL :: Partial => Int64 -> BSL.ByteString -> [BSL.ByteString]
chunksOfBSL :: Partial => Int64 -> ByteString -> [ByteString]
chunksOfBSL Int64
i ByteString
_ | Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0 = [Char] -> [ByteString]
forall a. Partial => [Char] -> a
error ([Char] -> [ByteString]) -> [Char] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ [Char]
"chunksOf, number must be positive, got " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int64 -> [Char]
forall a. Show a => a -> [Char]
show Int64
i
chunksOfBSL Int64
i ByteString
xs = (ByteString -> (ByteString, ByteString))
-> ByteString -> [ByteString]
forall b. (ByteString -> (b, ByteString)) -> ByteString -> [b]
repeatedlyBSL (Int64 -> ByteString -> (ByteString, ByteString)
BSL.splitAt Int64
i) ByteString
xs

-- | Split a strict 'BS.ByteString' into chunks of at most @n@ bytes.
chunksOfBS :: Partial => Int -> BS.ByteString -> [BS.ByteString]
chunksOfBS :: Partial => Int -> ByteString -> [ByteString]
chunksOfBS Int
i ByteString
_ | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Char] -> [ByteString]
forall a. Partial => [Char] -> a
error ([Char] -> [ByteString]) -> [Char] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ [Char]
"chunksOf, number must be positive, got " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i
chunksOfBS Int
i ByteString
xs = (ByteString -> (ByteString, ByteString))
-> ByteString -> [ByteString]
forall b. (ByteString -> (b, ByteString)) -> ByteString -> [b]
repeatedlyBS (Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
i) ByteString
xs

repeatedlyBSL :: (BSL.ByteString -> (b, BSL.ByteString)) -> BSL.ByteString -> [b]
repeatedlyBSL :: forall b. (ByteString -> (b, ByteString)) -> ByteString -> [b]
repeatedlyBSL ByteString -> (b, ByteString)
f ByteString
bs
    | ByteString -> Bool
BSL.null ByteString
bs = []
    | Bool
otherwise   = b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
: (ByteString -> (b, ByteString)) -> ByteString -> [b]
forall b. (ByteString -> (b, ByteString)) -> ByteString -> [b]
repeatedlyBSL ByteString -> (b, ByteString)
f ByteString
bs'
  where (b
b, ByteString
bs') = ByteString -> (b, ByteString)
f ByteString
bs

repeatedlyBS :: (BS.ByteString -> (b, BS.ByteString)) -> BS.ByteString -> [b]
repeatedlyBS :: forall b. (ByteString -> (b, ByteString)) -> ByteString -> [b]
repeatedlyBS ByteString -> (b, ByteString)
f ByteString
bs
    | ByteString -> Bool
BS.null ByteString
bs = []
    | Bool
otherwise  = b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
: (ByteString -> (b, ByteString)) -> ByteString -> [b]
forall b. (ByteString -> (b, ByteString)) -> ByteString -> [b]
repeatedlyBS ByteString -> (b, ByteString)
f ByteString
bs'
  where (b
b, ByteString
bs') = ByteString -> (b, ByteString)
f ByteString
bs


-- | Encode 'T.Text' as raw UTF-8 bytes into the 'Put' monad.
putTextUtf8 :: T.Text -> Put ()
putTextUtf8 :: Text -> Put ()
putTextUtf8 = ByteString -> Put ()
putByteString (ByteString -> Put ()) -> (Text -> ByteString) -> Text -> Put ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

-- | Decode a big-endian value from a strict 'BS.ByteString', throwing on failure.
decodeStrict :: forall a. HasEndianness a => BS.ByteString -> a
decodeStrict :: forall a. HasEndianness a => ByteString -> a
decodeStrict ByteString
bs = case Get a -> ByteString -> Either [Char] a
forall a. Get a -> ByteString -> Either [Char] a
runGet (forall a. Persist (BigEndian a) => Get a
getBE @a) ByteString
bs of
  Left [Char]
e  -> [Char] -> a
forall a. Partial => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"decodeStrict: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
e
  Right a
v -> a
v

-- | Encode a value as a big-endian strict 'BS.ByteString'.
encodeStrict :: HasEndianness a => a -> BS.ByteString
encodeStrict :: forall a. HasEndianness a => a -> ByteString
encodeStrict = Put () -> ByteString
forall a. Put a -> ByteString
runPut (Put () -> ByteString) -> (a -> Put ()) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put ()
forall a. Persist (BigEndian a) => a -> Put ()
putBE


-- | Convert a lazy 'BSL.ByteString' to an uppercase hex-encoded strict 'BS.ByteString'.
lazyByteStringToHex :: BSL.ByteString -> BS.ByteString
lazyByteStringToHex :: ByteString -> ByteString
lazyByteStringToHex ByteString
bs = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
" " ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ([Word8] -> ByteString) -> [[Word8]] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map [Word8] -> ByteString
BS.pack ([[Word8]] -> [ByteString]) -> [[Word8]] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> [Word8] -> [[Word8]]
forall e. Int -> [e] -> [[e]]
Data.List.Split.chunksOf Int
2 ([Word8] -> [[Word8]]) -> [Word8] -> [[Word8]]
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8) -> [Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word8
toUpper ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
lazyByteStringHex ByteString
bs


-- | Return 'V.Failure' with the given error when the condition is 'True', otherwise 'V.Success'.
whenInvalid :: a -> Bool -> T.Text -> V.Validation [T.Text] a
whenInvalid :: forall a. a -> Bool -> Text -> Validation [Text] a
whenInvalid a
x Bool
invalid Text
err =
  if Bool
invalid then
    [Text] -> Validation [Text] a
forall e a. e -> Validation e a
V.Failure [Text
err]
  else
    a -> Validation [Text] a
forall e a. a -> Validation e a
V.Success a
x