{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE TypeOperators       #-}

-- |
-- Module      :  Data.Solidity.Prim.Bytes
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  noportable
--
-- Bytes and BytesN primitive types.
--

module Data.Solidity.Prim.Bytes
    (
    -- * The dynamic length @Bytes@ type
      Bytes

    -- * The fixed length @BytesN@ type
    , BytesN
    ) where

import           Control.Monad           (unless, void)
import           Data.Aeson              (FromJSON (..), ToJSON (..),
                                          Value (String))
import           Data.ByteArray          (Bytes, convert, length, zero)
import           Data.ByteArray.Encoding (Base (Base16), convertFromBase,
                                          convertToBase)
import           Data.ByteArray.Sized    (SizedByteArray, unSizedByteArray,
                                          unsafeFromByteArrayAccess)
import qualified Data.ByteArray.Sized    as S (take)
import           Data.ByteString         (ByteString)
import qualified Data.ByteString.Char8   as C8
import           Data.Proxy              (Proxy (..))
import           Data.Serialize          (Get, Putter, getBytes, putByteString)
import           Data.String             (IsString (..))
import qualified Data.Text               as T (append, drop, take)
import           Data.Text.Encoding      (decodeUtf8, encodeUtf8)
import           GHC.TypeLits
import           Prelude                 hiding (length)

import           Data.Solidity.Abi       (AbiGet (..), AbiPut (..),
                                          AbiType (..))
import           Data.Solidity.Prim.Int  (getWord256, putWord256)

instance AbiType ByteString where
    isDynamic :: Proxy ByteString -> Bool
isDynamic Proxy ByteString
_ = Bool
True

instance AbiGet ByteString where
    abiGet :: Get ByteString
abiGet = Get ByteString
abiGetByteString

instance AbiPut ByteString where
    abiPut :: Putter ByteString
abiPut = Putter ByteString
abiPutByteString

instance AbiType Bytes where
    isDynamic :: Proxy Bytes -> Bool
isDynamic Proxy Bytes
_ = Bool
True

instance AbiGet Bytes where
    abiGet :: Get Bytes
abiGet = ByteString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (ByteString -> Bytes) -> Get ByteString -> Get Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
abiGetByteString

instance AbiPut Bytes where
    abiPut :: Putter Bytes
abiPut = Putter ByteString
abiPutByteString Putter ByteString -> (Bytes -> ByteString) -> Putter Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert

instance IsString Bytes where
    fromString :: String -> Bytes
fromString (Char
'0' : Char
'x' : String
hex) = (String -> Bytes)
-> (Bytes -> Bytes) -> Either String Bytes -> Bytes
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Bytes
forall a. HasCallStack => String -> a
error Bytes -> Bytes
forall a. a -> a
id (Either String Bytes -> Bytes) -> Either String Bytes -> Bytes
forall a b. (a -> b) -> a -> b
$ Base -> ByteString -> Either String Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base16 (String -> ByteString
C8.pack String
hex)
    fromString String
str               = ByteString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (String -> ByteString
C8.pack String
str)

instance FromJSON Bytes where
    parseJSON :: Value -> Parser Bytes
parseJSON (String Text
hex)
        | Int -> Text -> Text
T.take Int
2 Text
hex Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"0x" =
            (String -> Parser Bytes)
-> (Bytes -> Parser Bytes) -> Either String Bytes -> Parser Bytes
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser Bytes
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Bytes -> Parser Bytes
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Bytes -> Parser Bytes)
-> Either String Bytes -> Parser Bytes
forall a b. (a -> b) -> a -> b
$ Base -> ByteString -> Either String Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base16 (ByteString -> Either String Bytes)
-> ByteString -> Either String Bytes
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
2 Text
hex
        | Bool
otherwise = String -> Parser Bytes
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Hex string should have '0x' prefix"
    parseJSON Value
_ = String -> Parser Bytes
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Bytes should be encoded as hex string"

instance ToJSON Bytes where
    toJSON :: Bytes -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Bytes -> Text) -> Bytes -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append Text
"0x" (Text -> Text) -> (Bytes -> Text) -> Bytes -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (Bytes -> ByteString) -> Bytes -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> Bytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base16

-- | Sized byte array with fixed length in bytes
type BytesN n = SizedByteArray n Bytes

instance (n <= 32) => AbiType (BytesN n) where
    isDynamic :: Proxy (BytesN n) -> Bool
isDynamic Proxy (BytesN n)
_ = Bool
False

instance (KnownNat n, n <= 32) => AbiGet (BytesN n) where
    abiGet :: Get (BytesN n)
abiGet = do
        BytesN 32
ba <- ByteString -> BytesN 32
forall (n :: Nat) bin bout.
(ByteArrayAccess bin, ByteArrayN n bout, KnownNat n) =>
bin -> bout
unsafeFromByteArrayAccess (ByteString -> BytesN 32) -> Get ByteString -> Get (BytesN 32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getBytes Int
32
        BytesN n -> Get (BytesN n)
forall (m :: * -> *) a. Monad m => a -> m a
return (BytesN n -> Get (BytesN n)) -> BytesN n -> Get (BytesN n)
forall a b. (a -> b) -> a -> b
$ BytesN 32 -> BytesN n
forall (nbo :: Nat) (nbi :: Nat) bi bo.
(ByteArrayN nbi bi, ByteArrayN nbo bo, ByteArrayAccess bi,
 KnownNat nbi, KnownNat nbo, nbo <= nbi) =>
bi -> bo
S.take (BytesN 32
ba :: BytesN 32)

instance (KnownNat n, n <= 32) => AbiPut (BytesN n) where
    abiPut :: Putter (BytesN n)
abiPut BytesN n
ba = Putter ByteString
putByteString Putter ByteString -> Putter ByteString
forall a b. (a -> b) -> a -> b
$ BytesN n -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert BytesN n
ba ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString
forall ba. ByteArray ba => Int -> ba
zero (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len)
      where len :: Int
len = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)

instance (KnownNat n, n <= 32) => IsString (BytesN n) where
    fromString :: String -> BytesN n
fromString String
s = Bytes -> BytesN n
forall (n :: Nat) bin bout.
(ByteArrayAccess bin, ByteArrayN n bout, KnownNat n) =>
bin -> bout
unsafeFromByteArrayAccess Bytes
padded
      where bytes :: Bytes
bytes = String -> Bytes
forall a. IsString a => String -> a
fromString String
s :: Bytes
            len :: Int
len = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)
            padded :: Bytes
padded = Bytes
bytes Bytes -> Bytes -> Bytes
forall a. Semigroup a => a -> a -> a
<> Int -> Bytes
forall ba. ByteArray ba => Int -> ba
zero (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Bytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length Bytes
bytes)

instance (KnownNat n, n <= 32) => FromJSON (BytesN n) where
    parseJSON :: Value -> Parser (BytesN n)
parseJSON Value
v = do Bytes
ba <- Value -> Parser Bytes
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
                     BytesN n -> Parser (BytesN n)
forall (m :: * -> *) a. Monad m => a -> m a
return (BytesN n -> Parser (BytesN n)) -> BytesN n -> Parser (BytesN n)
forall a b. (a -> b) -> a -> b
$ Bytes -> BytesN n
forall (n :: Nat) bin bout.
(ByteArrayAccess bin, ByteArrayN n bout, KnownNat n) =>
bin -> bout
unsafeFromByteArrayAccess (Bytes
ba :: Bytes)

instance (KnownNat n, n <= 32) => ToJSON (BytesN n) where
    toJSON :: BytesN n -> Value
toJSON BytesN n
ba = Bytes -> Value
forall a. ToJSON a => a -> Value
toJSON (BytesN n -> Bytes
forall (n :: Nat) ba. SizedByteArray n ba -> ba
unSizedByteArray BytesN n
ba :: Bytes)

abiGetByteString :: Get ByteString
abiGetByteString :: Get ByteString
abiGetByteString = do
    Int
len <- Word256 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word256 -> Int) -> Get Word256 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word256
getWord256
    ByteString
res <- Int -> Get ByteString
getBytes Int
len
    let remainder :: Int
remainder = Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
32
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
remainder Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
      Get ByteString -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Get ByteString -> Get ()) -> Get ByteString -> Get ()
forall a b. (a -> b) -> a -> b
$ Int -> Get ByteString
getBytes (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
remainder)
    ByteString -> Get ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
res

abiPutByteString :: Putter ByteString
abiPutByteString :: Putter ByteString
abiPutByteString ByteString
bs = do
    Putter Word256
putWord256 Putter Word256 -> Putter Word256
forall a b. (a -> b) -> a -> b
$ Int -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
    Putter ByteString
putByteString ByteString
bs
    Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
remainder Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$
      Putter ByteString
putByteString Putter ByteString -> Putter ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString
forall ba. ByteArray ba => Int -> ba
zero (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
remainder)
  where len :: Int
len = ByteString -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length ByteString
bs
        remainder :: Int
remainder = Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
32