{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}

-- |
-- Module      :  Data.BigNum
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  unportable
--
-- Big numbers and codecs for Haskell Web3 library.
--

module Data.BigNum (Word256, Word128, H160, h160, H256, h256, H512, h512) where

import           Codec.Scale                      ()
import           Codec.Scale.Class                (Decode (..), Encode (..))
import           Data.ByteArray                   (ByteArrayAccess, Bytes,
                                                   convert)
import qualified Data.ByteArray                   as A (length)
import           Data.ByteArray.HexString.Convert (FromHex (..), ToHex (..),
                                                   fromBytes)
import           Data.Maybe                       (fromJust)
import           Data.Serialize.Get               (getByteString)
import           Data.Serialize.Put               (putByteString)
import           Data.String                      (IsString (..))
import           Data.WideWord.Word128            (Word128 (..))
import           Data.WideWord.Word256            (Word256 (..))

instance Encode Word128 where
    put :: Putter Word128
put (Word128 Word64
l Word64
h)= Putter Word64
forall a. Encode a => Putter a
put Word64
h PutM () -> PutM () -> PutM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Word64
forall a. Encode a => Putter a
put Word64
l

instance Decode Word128 where
    get :: Get Word128
get = (Word64 -> Word64 -> Word128) -> Word64 -> Word64 -> Word128
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word64 -> Word64 -> Word128
Word128 (Word64 -> Word64 -> Word128)
-> Get Word64 -> Get (Word64 -> Word128)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
forall a. Decode a => Get a
get Get (Word64 -> Word128) -> Get Word64 -> Get Word128
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
forall a. Decode a => Get a
get

instance Encode Word256 where
    put :: Putter Word256
put (Word256 Word64
lx Word64
hx Word64
l Word64
h) = do
        Putter Word64
forall a. Encode a => Putter a
put Word64
h
        Putter Word64
forall a. Encode a => Putter a
put Word64
l
        Putter Word64
forall a. Encode a => Putter a
put Word64
hx
        Putter Word64
forall a. Encode a => Putter a
put Word64
lx

instance Decode Word256 where
    get :: Get Word256
get = do
        Word64
h <- Get Word64
forall a. Decode a => Get a
get
        Word64
l <- Get Word64
forall a. Decode a => Get a
get
        Word64
hx <- Get Word64
forall a. Decode a => Get a
get
        Word64
lx <- Get Word64
forall a. Decode a => Get a
get
        Word256 -> Get Word256
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Word64 -> Word64 -> Word64 -> Word256
Word256 Word64
lx Word64
hx Word64
l Word64
h)

-- | 20 byte of data.
newtype H160 = H160 Bytes
    deriving (H160 -> H160 -> Bool
(H160 -> H160 -> Bool) -> (H160 -> H160 -> Bool) -> Eq H160
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: H160 -> H160 -> Bool
$c/= :: H160 -> H160 -> Bool
== :: H160 -> H160 -> Bool
$c== :: H160 -> H160 -> Bool
Eq, Eq H160
Eq H160
-> (H160 -> H160 -> Ordering)
-> (H160 -> H160 -> Bool)
-> (H160 -> H160 -> Bool)
-> (H160 -> H160 -> Bool)
-> (H160 -> H160 -> Bool)
-> (H160 -> H160 -> H160)
-> (H160 -> H160 -> H160)
-> Ord H160
H160 -> H160 -> Bool
H160 -> H160 -> Ordering
H160 -> H160 -> H160
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: H160 -> H160 -> H160
$cmin :: H160 -> H160 -> H160
max :: H160 -> H160 -> H160
$cmax :: H160 -> H160 -> H160
>= :: H160 -> H160 -> Bool
$c>= :: H160 -> H160 -> Bool
> :: H160 -> H160 -> Bool
$c> :: H160 -> H160 -> Bool
<= :: H160 -> H160 -> Bool
$c<= :: H160 -> H160 -> Bool
< :: H160 -> H160 -> Bool
$c< :: H160 -> H160 -> Bool
compare :: H160 -> H160 -> Ordering
$ccompare :: H160 -> H160 -> Ordering
$cp1Ord :: Eq H160
Ord, H160 -> Int
H160 -> Ptr p -> IO ()
H160 -> (Ptr p -> IO a) -> IO a
(H160 -> Int)
-> (forall p a. H160 -> (Ptr p -> IO a) -> IO a)
-> (forall p. H160 -> Ptr p -> IO ())
-> ByteArrayAccess H160
forall p. H160 -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. H160 -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: H160 -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. H160 -> Ptr p -> IO ()
withByteArray :: H160 -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. H160 -> (Ptr p -> IO a) -> IO a
length :: H160 -> Int
$clength :: H160 -> Int
ByteArrayAccess)

-- | Convert any 20 byte array into H160 type, otherwise returns Nothing.
h160 :: ByteArrayAccess a => a -> Maybe H160
h160 :: a -> Maybe H160
h160 a
ba
  | a -> Int
forall ba. ByteArrayAccess ba => ba -> Int
A.length a
ba Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
20 = H160 -> Maybe H160
forall a. a -> Maybe a
Just (H160 -> Maybe H160) -> H160 -> Maybe H160
forall a b. (a -> b) -> a -> b
$ Bytes -> H160
H160 (a -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert a
ba)
  | Bool
otherwise = Maybe H160
forall a. Maybe a
Nothing

instance FromHex H160 where
    fromHex :: HexString -> Either String H160
fromHex HexString
bs
      | HexString -> Int
forall ba. ByteArrayAccess ba => ba -> Int
A.length HexString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
20 = H160 -> Either String H160
forall a b. b -> Either a b
Right (H160 -> Either String H160) -> H160 -> Either String H160
forall a b. (a -> b) -> a -> b
$ Bytes -> H160
H160 (HexString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert HexString
bs)
      | Bool
otherwise = String -> Either String H160
forall a b. a -> Either a b
Left (String
"wrong length: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (HexString -> Int
forall ba. ByteArrayAccess ba => ba -> Int
A.length HexString
bs))

instance ToHex H160 where
    toHex :: H160 -> HexString
toHex = H160 -> HexString
forall ba. ByteArrayAccess ba => ba -> HexString
fromBytes

instance Show H160 where
    show :: H160 -> String
show = HexString -> String
forall a. Show a => a -> String
show (HexString -> String) -> (H160 -> HexString) -> H160 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. H160 -> HexString
forall a. ToHex a => a -> HexString
toHex

instance IsString H160 where
    fromString :: String -> H160
fromString = (String -> H160) -> (H160 -> H160) -> Either String H160 -> H160
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> H160
forall a. HasCallStack => String -> a
error H160 -> H160
forall a. a -> a
id (Either String H160 -> H160)
-> (String -> Either String H160) -> String -> H160
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexString -> Either String H160
forall a. FromHex a => HexString -> Either String a
fromHex (HexString -> Either String H160)
-> (String -> HexString) -> String -> Either String H160
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HexString
forall a. IsString a => String -> a
fromString

instance Encode H160 where
    put :: Putter H160
put = Putter ByteString
putByteString Putter ByteString -> (H160 -> ByteString) -> Putter H160
forall b c a. (b -> c) -> (a -> b) -> a -> c
. H160 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert

instance Decode H160 where
    get :: Get H160
get = (Maybe H160 -> H160
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe H160 -> H160)
-> (ByteString -> Maybe H160) -> ByteString -> H160
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe H160
forall a. ByteArrayAccess a => a -> Maybe H160
h160) (ByteString -> H160) -> Get ByteString -> Get H160
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
20

-- | 32 byte of data.
newtype H256 = H256 Bytes
    deriving (H256 -> H256 -> Bool
(H256 -> H256 -> Bool) -> (H256 -> H256 -> Bool) -> Eq H256
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: H256 -> H256 -> Bool
$c/= :: H256 -> H256 -> Bool
== :: H256 -> H256 -> Bool
$c== :: H256 -> H256 -> Bool
Eq, Eq H256
Eq H256
-> (H256 -> H256 -> Ordering)
-> (H256 -> H256 -> Bool)
-> (H256 -> H256 -> Bool)
-> (H256 -> H256 -> Bool)
-> (H256 -> H256 -> Bool)
-> (H256 -> H256 -> H256)
-> (H256 -> H256 -> H256)
-> Ord H256
H256 -> H256 -> Bool
H256 -> H256 -> Ordering
H256 -> H256 -> H256
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: H256 -> H256 -> H256
$cmin :: H256 -> H256 -> H256
max :: H256 -> H256 -> H256
$cmax :: H256 -> H256 -> H256
>= :: H256 -> H256 -> Bool
$c>= :: H256 -> H256 -> Bool
> :: H256 -> H256 -> Bool
$c> :: H256 -> H256 -> Bool
<= :: H256 -> H256 -> Bool
$c<= :: H256 -> H256 -> Bool
< :: H256 -> H256 -> Bool
$c< :: H256 -> H256 -> Bool
compare :: H256 -> H256 -> Ordering
$ccompare :: H256 -> H256 -> Ordering
$cp1Ord :: Eq H256
Ord, H256 -> Int
H256 -> Ptr p -> IO ()
H256 -> (Ptr p -> IO a) -> IO a
(H256 -> Int)
-> (forall p a. H256 -> (Ptr p -> IO a) -> IO a)
-> (forall p. H256 -> Ptr p -> IO ())
-> ByteArrayAccess H256
forall p. H256 -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. H256 -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: H256 -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. H256 -> Ptr p -> IO ()
withByteArray :: H256 -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. H256 -> (Ptr p -> IO a) -> IO a
length :: H256 -> Int
$clength :: H256 -> Int
ByteArrayAccess)

-- | Convert any 32 byte array into H256 type, otherwise returns Nothing.
h256 :: ByteArrayAccess a => a -> Maybe H256
h256 :: a -> Maybe H256
h256 a
ba
  | a -> Int
forall ba. ByteArrayAccess ba => ba -> Int
A.length a
ba Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 = H256 -> Maybe H256
forall a. a -> Maybe a
Just (H256 -> Maybe H256) -> H256 -> Maybe H256
forall a b. (a -> b) -> a -> b
$ Bytes -> H256
H256 (a -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert a
ba)
  | Bool
otherwise = Maybe H256
forall a. Maybe a
Nothing

instance FromHex H256 where
    fromHex :: HexString -> Either String H256
fromHex HexString
bs
      | HexString -> Int
forall ba. ByteArrayAccess ba => ba -> Int
A.length HexString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 = H256 -> Either String H256
forall a b. b -> Either a b
Right (H256 -> Either String H256) -> H256 -> Either String H256
forall a b. (a -> b) -> a -> b
$ Bytes -> H256
H256 (HexString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert HexString
bs)
      | Bool
otherwise = String -> Either String H256
forall a b. a -> Either a b
Left (String
"wrong length: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (HexString -> Int
forall ba. ByteArrayAccess ba => ba -> Int
A.length HexString
bs))

instance ToHex H256 where
    toHex :: H256 -> HexString
toHex = H256 -> HexString
forall ba. ByteArrayAccess ba => ba -> HexString
fromBytes

instance Show H256 where
    show :: H256 -> String
show = HexString -> String
forall a. Show a => a -> String
show (HexString -> String) -> (H256 -> HexString) -> H256 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. H256 -> HexString
forall a. ToHex a => a -> HexString
toHex

instance IsString H256 where
    fromString :: String -> H256
fromString = (String -> H256) -> (H256 -> H256) -> Either String H256 -> H256
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> H256
forall a. HasCallStack => String -> a
error H256 -> H256
forall a. a -> a
id (Either String H256 -> H256)
-> (String -> Either String H256) -> String -> H256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexString -> Either String H256
forall a. FromHex a => HexString -> Either String a
fromHex (HexString -> Either String H256)
-> (String -> HexString) -> String -> Either String H256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HexString
forall a. IsString a => String -> a
fromString

instance Encode H256 where
    put :: Putter H256
put = Putter ByteString
putByteString Putter ByteString -> (H256 -> ByteString) -> Putter H256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. H256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert

instance Decode H256 where
    get :: Get H256
get = (Maybe H256 -> H256
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe H256 -> H256)
-> (ByteString -> Maybe H256) -> ByteString -> H256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe H256
forall a. ByteArrayAccess a => a -> Maybe H256
h256) (ByteString -> H256) -> Get ByteString -> Get H256
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
32

-- | 64 byte of data.
newtype H512 = H512 Bytes
    deriving (H512 -> H512 -> Bool
(H512 -> H512 -> Bool) -> (H512 -> H512 -> Bool) -> Eq H512
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: H512 -> H512 -> Bool
$c/= :: H512 -> H512 -> Bool
== :: H512 -> H512 -> Bool
$c== :: H512 -> H512 -> Bool
Eq, Eq H512
Eq H512
-> (H512 -> H512 -> Ordering)
-> (H512 -> H512 -> Bool)
-> (H512 -> H512 -> Bool)
-> (H512 -> H512 -> Bool)
-> (H512 -> H512 -> Bool)
-> (H512 -> H512 -> H512)
-> (H512 -> H512 -> H512)
-> Ord H512
H512 -> H512 -> Bool
H512 -> H512 -> Ordering
H512 -> H512 -> H512
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: H512 -> H512 -> H512
$cmin :: H512 -> H512 -> H512
max :: H512 -> H512 -> H512
$cmax :: H512 -> H512 -> H512
>= :: H512 -> H512 -> Bool
$c>= :: H512 -> H512 -> Bool
> :: H512 -> H512 -> Bool
$c> :: H512 -> H512 -> Bool
<= :: H512 -> H512 -> Bool
$c<= :: H512 -> H512 -> Bool
< :: H512 -> H512 -> Bool
$c< :: H512 -> H512 -> Bool
compare :: H512 -> H512 -> Ordering
$ccompare :: H512 -> H512 -> Ordering
$cp1Ord :: Eq H512
Ord, H512 -> Int
H512 -> Ptr p -> IO ()
H512 -> (Ptr p -> IO a) -> IO a
(H512 -> Int)
-> (forall p a. H512 -> (Ptr p -> IO a) -> IO a)
-> (forall p. H512 -> Ptr p -> IO ())
-> ByteArrayAccess H512
forall p. H512 -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. H512 -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: H512 -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. H512 -> Ptr p -> IO ()
withByteArray :: H512 -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. H512 -> (Ptr p -> IO a) -> IO a
length :: H512 -> Int
$clength :: H512 -> Int
ByteArrayAccess)

-- | Convert any 64 byte array into H512 type, otherwise returns Nothing.
h512 :: ByteArrayAccess a => a -> Maybe H512
h512 :: a -> Maybe H512
h512 a
ba
  | a -> Int
forall ba. ByteArrayAccess ba => ba -> Int
A.length a
ba Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
64 = H512 -> Maybe H512
forall a. a -> Maybe a
Just (H512 -> Maybe H512) -> H512 -> Maybe H512
forall a b. (a -> b) -> a -> b
$ Bytes -> H512
H512 (a -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert a
ba)
  | Bool
otherwise = Maybe H512
forall a. Maybe a
Nothing

instance FromHex H512 where
    fromHex :: HexString -> Either String H512
fromHex HexString
bs
      | HexString -> Int
forall ba. ByteArrayAccess ba => ba -> Int
A.length HexString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
64 = H512 -> Either String H512
forall a b. b -> Either a b
Right (H512 -> Either String H512) -> H512 -> Either String H512
forall a b. (a -> b) -> a -> b
$ Bytes -> H512
H512 (HexString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert HexString
bs)
      | Bool
otherwise = String -> Either String H512
forall a b. a -> Either a b
Left (String
"wrong length: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (HexString -> Int
forall ba. ByteArrayAccess ba => ba -> Int
A.length HexString
bs))

instance ToHex H512 where
    toHex :: H512 -> HexString
toHex = H512 -> HexString
forall ba. ByteArrayAccess ba => ba -> HexString
fromBytes

instance Show H512 where
    show :: H512 -> String
show = HexString -> String
forall a. Show a => a -> String
show (HexString -> String) -> (H512 -> HexString) -> H512 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. H512 -> HexString
forall a. ToHex a => a -> HexString
toHex

instance IsString H512 where
    fromString :: String -> H512
fromString = (String -> H512) -> (H512 -> H512) -> Either String H512 -> H512
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> H512
forall a. HasCallStack => String -> a
error H512 -> H512
forall a. a -> a
id (Either String H512 -> H512)
-> (String -> Either String H512) -> String -> H512
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexString -> Either String H512
forall a. FromHex a => HexString -> Either String a
fromHex (HexString -> Either String H512)
-> (String -> HexString) -> String -> Either String H512
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HexString
forall a. IsString a => String -> a
fromString

instance Encode H512 where
    put :: Putter H512
put = Putter ByteString
putByteString Putter ByteString -> (H512 -> ByteString) -> Putter H512
forall b c a. (b -> c) -> (a -> b) -> a -> c
. H512 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert

instance Decode H512 where
    get :: Get H512
get = (Maybe H512 -> H512
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe H512 -> H512)
-> (ByteString -> Maybe H512) -> ByteString -> H512
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe H512
forall a. ByteArrayAccess a => a -> Maybe H512
h512) (ByteString -> H512) -> Get ByteString -> Get H512
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
64