{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies      #-}

-- |
-- Module      :  Network.Polkadot.Account
-- Copyright   :  Aleksandr Krupenkin 2016-2024
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  portable
--
-- Polkadot account types.
--

module Network.Polkadot.Account (Ss58Codec(..), IdentifyAccount(..)) where

import           Codec.Scale                 (decode, encode)
import           Control.Monad               ((<=<))
import           Data.BigNum                 (h256)
import           Data.Bits                   (bit, shiftL, shiftR, (.&.), (.|.))
import           Data.ByteArray              (cons, convert)
import           Data.ByteString             (ByteString)
import qualified Data.ByteString             as BS (drop, length, pack, take)
import           Data.ByteString.Base58      (bitcoinAlphabet, decodeBase58,
                                              encodeBase58)
import           Data.Digest.Blake2          (blake2_256, blake2_512)
import           Data.Maybe                  (fromJust)
import           Data.Word                   (Word16)

import           Network.Polkadot.Primitives (MultiSigner (..))
import qualified Network.Polkadot.Primitives as P (AccountId)

-- | Some type that is able to be collapsed into an account ID.
--
-- It is not possible to recreate the original value from the account ID.
class IdentifyAccount a where
    -- | The account ID that this can be transformed into.
    type AccountId a

    -- | Transform into an account.
    into_account :: a -> AccountId a

instance IdentifyAccount MultiSigner where
    type AccountId MultiSigner = P.AccountId
    into_account :: MultiSigner -> AccountId MultiSigner
into_account (Ed25519Signer H256
pub) = Maybe H256 -> H256
forall a. HasCallStack => Maybe a -> a
fromJust (H256 -> Maybe H256
forall a. ByteArrayAccess a => a -> Maybe H256
h256 H256
pub)
    into_account (EcdsaSigner Word8
px H256
pub)   = Maybe H256 -> H256
forall a. HasCallStack => Maybe a -> a
fromJust (ByteString -> Maybe H256
forall a. ByteArrayAccess a => a -> Maybe H256
h256 (ByteString -> Maybe H256) -> ByteString -> Maybe H256
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
blake2_256 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> ByteString
forall a. ByteArray a => Word8 -> a -> a
cons Word8
px (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ H256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert H256
pub)
    into_account MultiSigner
Sr25519Signer       = String -> H256
forall a. HasCallStack => String -> a
error String
"Sr25519 has no support yet"

instance Show MultiSigner where
    show :: MultiSigner -> String
show = ByteString -> String
forall a. Show a => a -> String
show (ByteString -> String)
-> (MultiSigner -> ByteString) -> MultiSigner -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. H256 -> ByteString
forall a. Ss58Codec a => a -> ByteString
to_ss58check (H256 -> ByteString)
-> (MultiSigner -> H256) -> MultiSigner -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiSigner -> H256
MultiSigner -> AccountId MultiSigner
forall a. IdentifyAccount a => a -> AccountId a
into_account

-- | Key that can be encoded to/from SS58.
--
-- See <https://github.com/paritytech/substrate/wiki/External-Address-Format-(SS58)#address-type>
-- for information on the codec.
class Ss58Codec a where
    -- | Some if the string is a properly encoded SS58Check address (default prefix).
    from_ss58check :: ByteString -> Either String a
    from_ss58check = Word16 -> ByteString -> Either String a
forall a. Ss58Codec a => Word16 -> ByteString -> Either String a
from_ss58check_with_version Word16
42

    -- | Return the ss58-check string for this key (default prefix).
    to_ss58check :: a -> ByteString
    to_ss58check = Word16 -> a -> ByteString
forall a. Ss58Codec a => Word16 -> a -> ByteString
to_ss58check_with_version Word16
42

    -- | Return the ss58-check string for this key.
    to_ss58check_with_version :: Word16 -> a -> ByteString

    -- | Some if the string is a properly encoded SS58Check address (default prefix).
    from_ss58check_with_version :: Word16 -> ByteString -> Either String a

instance Ss58Codec P.AccountId where
    from_ss58check_with_version :: Word16 -> ByteString -> Either String H256
from_ss58check_with_version Word16
v = ByteString -> Either String H256
forall ba a.
(ByteArrayAccess ba, Decode a) =>
ba -> Either String a
decode (ByteString -> Either String H256)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Either String H256
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Word16 -> ByteString -> Either String ByteString
from_ss58check_with_version' Word16
v (ByteString -> Either String ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Either String ByteString
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> Either String ByteString
from_base58
    to_ss58check_with_version :: Word16 -> H256 -> ByteString
to_ss58check_with_version Word16
v = ByteString -> ByteString
to_base58 (ByteString -> ByteString)
-> (H256 -> ByteString) -> H256 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> ByteString -> ByteString
to_ss58check_with_version' Word16
v (ByteString -> ByteString)
-> (H256 -> ByteString) -> H256 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. H256 -> ByteString
forall a ba. (Encode a, ByteArray ba) => a -> ba
encode

to_base58 :: ByteString -> ByteString
to_base58 :: ByteString -> ByteString
to_base58 = Alphabet -> ByteString -> ByteString
encodeBase58 Alphabet
bitcoinAlphabet

from_base58 :: ByteString -> Either String ByteString
from_base58 :: ByteString -> Either String ByteString
from_base58 = Either String ByteString
-> (ByteString -> Either String ByteString)
-> Maybe ByteString
-> Either String ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String ByteString
forall a b. a -> Either a b
Left String
"Bad encoding") ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Maybe ByteString -> Either String ByteString)
-> (ByteString -> Maybe ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alphabet -> ByteString -> Maybe ByteString
decodeBase58 Alphabet
bitcoinAlphabet

to_ss58check_with_version' :: Word16 -> ByteString -> ByteString
to_ss58check_with_version' :: Word16 -> ByteString -> ByteString
to_ss58check_with_version' Word16
v ByteString
input = ByteString
out ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
ss58hash ByteString
out
  where
    out :: ByteString
out = Word16 -> ByteString
encode_version Word16
v ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
input

from_ss58check_with_version' :: Word16 -> ByteString -> Either String ByteString
from_ss58check_with_version' :: Word16 -> ByteString -> Either String ByteString
from_ss58check_with_version' Word16
v ByteString
input = Either String ()
versionGuard Either String ()
-> Either String ByteString -> Either String ByteString
forall a b. Either String a -> Either String b -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either String ByteString
ss58hashGuard
  where
    checksumLen :: Int
checksumLen = Int
2
    versionLen :: Int
versionLen | Word16
v Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
< Word16
64 = Int
1
               | Bool
otherwise = Int
2
    inputLen :: Int
inputLen = ByteString -> Int
BS.length ByteString
input Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
checksumLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
versionLen
    input' :: ByteString
input' = Int -> ByteString -> ByteString
BS.take Int
inputLen (Int -> ByteString -> ByteString
BS.drop Int
versionLen ByteString
input)
    versionGuard :: Either String ()
versionGuard
      | Word16 -> ByteString
encode_version Word16
v ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> ByteString -> ByteString
BS.take Int
versionLen ByteString
input = () -> Either String ()
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = String -> Either String ()
forall a b. a -> Either a b
Left String
"Bad version"
    ss58hashGuard :: Either String ByteString
ss58hashGuard
      | ByteString -> ByteString
ss58hash (Int -> ByteString -> ByteString
BS.take (Int
versionLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
inputLen) ByteString
input)
        ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> ByteString -> ByteString
BS.drop (Int
versionLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
inputLen) ByteString
input = ByteString -> Either String ByteString
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
input'
      | Bool
otherwise = String -> Either String ByteString
forall a b. a -> Either a b
Left String
"Bad checksum"

ss58hash :: ByteString -> ByteString
ss58hash :: ByteString -> ByteString
ss58hash = Int -> ByteString -> ByteString
BS.take Int
2 (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
blake2_512 (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
"SS58PRE" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>)

encode_version :: Word16 -> ByteString
encode_version :: Word16 -> ByteString
encode_version Word16
v
  | Word16
v Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
< Word16
64 = [Word8] -> ByteString
BS.pack [Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v]
  | Bool
otherwise = let first :: Word16
first = Int -> Word16
forall a. Bits a => Int -> a
bit Int
6 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. ((Word16
v Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
2) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
63)
                    second :: Word16
second = (Word16
v Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. ((Word16
v Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
3) Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
6)
                 in [Word8] -> ByteString
BS.pack (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word8) -> [Word16] -> [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word16
first, Word16
second])