-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Parsers that are used in "Morley.Client.TezosClient.Impl"
module Morley.Client.TezosClient.Parser
  ( parseBakerFeeFromOutput
  , parseSecretKeyEncryption
  ) where

import Data.Scientific (Scientific)
import Fmt (Buildable(..))
import Text.Megaparsec (choice, customFailure)
import Text.Megaparsec qualified as P (Parsec, parse, skipManyTill)
import Text.Megaparsec.Char (newline, printChar, space)
import Text.Megaparsec.Char.Lexer (lexeme, scientific, symbol)
import Text.Megaparsec.Error (ParseErrorBundle, ShowErrorComponent(..), errorBundlePretty)

import Morley.Client.TezosClient.Types (SecretKeyEncryption(..))
import Morley.Micheline
import Morley.Michelson.Parser.Helpers (count)
import Morley.Tezos.Core
import Morley.Util.SizedList.Types
import Unsafe qualified (unsafeM)

type Parser = P.Parsec Void Text

data FeeParserException = FeeParserException (ParseErrorBundle Text Void)
  deriving stock (FeeParserException -> FeeParserException -> Bool
(FeeParserException -> FeeParserException -> Bool)
-> (FeeParserException -> FeeParserException -> Bool)
-> Eq FeeParserException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FeeParserException -> FeeParserException -> Bool
$c/= :: FeeParserException -> FeeParserException -> Bool
== :: FeeParserException -> FeeParserException -> Bool
$c== :: FeeParserException -> FeeParserException -> Bool
Eq, Int -> FeeParserException -> ShowS
[FeeParserException] -> ShowS
FeeParserException -> String
(Int -> FeeParserException -> ShowS)
-> (FeeParserException -> String)
-> ([FeeParserException] -> ShowS)
-> Show FeeParserException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FeeParserException] -> ShowS
$cshowList :: [FeeParserException] -> ShowS
show :: FeeParserException -> String
$cshow :: FeeParserException -> String
showsPrec :: Int -> FeeParserException -> ShowS
$cshowsPrec :: Int -> FeeParserException -> ShowS
Show)

instance Exception FeeParserException where
  displayException :: FeeParserException -> String
displayException (FeeParserException ParseErrorBundle Text Void
bundle) = ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text Void
bundle

instance Buildable FeeParserException where
  build :: FeeParserException -> Builder
build = String -> Builder
forall p. Buildable p => p -> Builder
build (String -> Builder)
-> (FeeParserException -> String) -> FeeParserException -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FeeParserException -> String
forall e. Exception e => e -> String
displayException
  -- this might seem backwards, but it's more efficient than converting to then from text
  -- which would have to happen in displayException if we define it in terms of build.

data SecretKeyEncryptionParserException =
  SecretKeyEncryptionParserException (ParseErrorBundle Text UnexpectedEncryptionType)
  deriving stock (SecretKeyEncryptionParserException
-> SecretKeyEncryptionParserException -> Bool
(SecretKeyEncryptionParserException
 -> SecretKeyEncryptionParserException -> Bool)
-> (SecretKeyEncryptionParserException
    -> SecretKeyEncryptionParserException -> Bool)
-> Eq SecretKeyEncryptionParserException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecretKeyEncryptionParserException
-> SecretKeyEncryptionParserException -> Bool
$c/= :: SecretKeyEncryptionParserException
-> SecretKeyEncryptionParserException -> Bool
== :: SecretKeyEncryptionParserException
-> SecretKeyEncryptionParserException -> Bool
$c== :: SecretKeyEncryptionParserException
-> SecretKeyEncryptionParserException -> Bool
Eq, Int -> SecretKeyEncryptionParserException -> ShowS
[SecretKeyEncryptionParserException] -> ShowS
SecretKeyEncryptionParserException -> String
(Int -> SecretKeyEncryptionParserException -> ShowS)
-> (SecretKeyEncryptionParserException -> String)
-> ([SecretKeyEncryptionParserException] -> ShowS)
-> Show SecretKeyEncryptionParserException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SecretKeyEncryptionParserException] -> ShowS
$cshowList :: [SecretKeyEncryptionParserException] -> ShowS
show :: SecretKeyEncryptionParserException -> String
$cshow :: SecretKeyEncryptionParserException -> String
showsPrec :: Int -> SecretKeyEncryptionParserException -> ShowS
$cshowsPrec :: Int -> SecretKeyEncryptionParserException -> ShowS
Show)

instance Buildable SecretKeyEncryptionParserException where
  build :: SecretKeyEncryptionParserException -> Builder
build (SecretKeyEncryptionParserException ParseErrorBundle Text UnexpectedEncryptionType
bundle) = String -> Builder
forall p. Buildable p => p -> Builder
build (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text UnexpectedEncryptionType -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text UnexpectedEncryptionType
bundle

data UnexpectedEncryptionType = UnexpectedEncryptionType
  deriving stock (UnexpectedEncryptionType -> UnexpectedEncryptionType -> Bool
(UnexpectedEncryptionType -> UnexpectedEncryptionType -> Bool)
-> (UnexpectedEncryptionType -> UnexpectedEncryptionType -> Bool)
-> Eq UnexpectedEncryptionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnexpectedEncryptionType -> UnexpectedEncryptionType -> Bool
$c/= :: UnexpectedEncryptionType -> UnexpectedEncryptionType -> Bool
== :: UnexpectedEncryptionType -> UnexpectedEncryptionType -> Bool
$c== :: UnexpectedEncryptionType -> UnexpectedEncryptionType -> Bool
Eq, Eq UnexpectedEncryptionType
Eq UnexpectedEncryptionType
-> (UnexpectedEncryptionType
    -> UnexpectedEncryptionType -> Ordering)
-> (UnexpectedEncryptionType -> UnexpectedEncryptionType -> Bool)
-> (UnexpectedEncryptionType -> UnexpectedEncryptionType -> Bool)
-> (UnexpectedEncryptionType -> UnexpectedEncryptionType -> Bool)
-> (UnexpectedEncryptionType -> UnexpectedEncryptionType -> Bool)
-> (UnexpectedEncryptionType
    -> UnexpectedEncryptionType -> UnexpectedEncryptionType)
-> (UnexpectedEncryptionType
    -> UnexpectedEncryptionType -> UnexpectedEncryptionType)
-> Ord UnexpectedEncryptionType
UnexpectedEncryptionType -> UnexpectedEncryptionType -> Bool
UnexpectedEncryptionType -> UnexpectedEncryptionType -> Ordering
UnexpectedEncryptionType
-> UnexpectedEncryptionType -> UnexpectedEncryptionType
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 :: UnexpectedEncryptionType
-> UnexpectedEncryptionType -> UnexpectedEncryptionType
$cmin :: UnexpectedEncryptionType
-> UnexpectedEncryptionType -> UnexpectedEncryptionType
max :: UnexpectedEncryptionType
-> UnexpectedEncryptionType -> UnexpectedEncryptionType
$cmax :: UnexpectedEncryptionType
-> UnexpectedEncryptionType -> UnexpectedEncryptionType
>= :: UnexpectedEncryptionType -> UnexpectedEncryptionType -> Bool
$c>= :: UnexpectedEncryptionType -> UnexpectedEncryptionType -> Bool
> :: UnexpectedEncryptionType -> UnexpectedEncryptionType -> Bool
$c> :: UnexpectedEncryptionType -> UnexpectedEncryptionType -> Bool
<= :: UnexpectedEncryptionType -> UnexpectedEncryptionType -> Bool
$c<= :: UnexpectedEncryptionType -> UnexpectedEncryptionType -> Bool
< :: UnexpectedEncryptionType -> UnexpectedEncryptionType -> Bool
$c< :: UnexpectedEncryptionType -> UnexpectedEncryptionType -> Bool
compare :: UnexpectedEncryptionType -> UnexpectedEncryptionType -> Ordering
$ccompare :: UnexpectedEncryptionType -> UnexpectedEncryptionType -> Ordering
Ord, Int -> UnexpectedEncryptionType -> ShowS
[UnexpectedEncryptionType] -> ShowS
UnexpectedEncryptionType -> String
(Int -> UnexpectedEncryptionType -> ShowS)
-> (UnexpectedEncryptionType -> String)
-> ([UnexpectedEncryptionType] -> ShowS)
-> Show UnexpectedEncryptionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnexpectedEncryptionType] -> ShowS
$cshowList :: [UnexpectedEncryptionType] -> ShowS
show :: UnexpectedEncryptionType -> String
$cshow :: UnexpectedEncryptionType -> String
showsPrec :: Int -> UnexpectedEncryptionType -> ShowS
$cshowsPrec :: Int -> UnexpectedEncryptionType -> ShowS
Show)

instance ShowErrorComponent UnexpectedEncryptionType where
  showErrorComponent :: UnexpectedEncryptionType -> String
showErrorComponent UnexpectedEncryptionType
UnexpectedEncryptionType =
    String
"Unexpected secret key encryption type occurred"

-- | Function to parse baker fee from given @octez-client@ output.
parseBakerFeeFromOutput
  :: forall n. (SingIPeano n) => Text -> Either FeeParserException (SizedList n TezosMutez)
parseBakerFeeFromOutput :: forall (n :: Nat).
SingIPeano n =>
Text -> Either FeeParserException (SizedList n TezosMutez)
parseBakerFeeFromOutput Text
output = (ParseErrorBundle Text Void -> FeeParserException)
-> Either
     (ParseErrorBundle Text Void) (SizedList' (ToPeano n) TezosMutez)
-> Either FeeParserException (SizedList' (ToPeano n) TezosMutez)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseErrorBundle Text Void -> FeeParserException
FeeParserException (Either
   (ParseErrorBundle Text Void) (SizedList' (ToPeano n) TezosMutez)
 -> Either FeeParserException (SizedList' (ToPeano n) TezosMutez))
-> Either
     (ParseErrorBundle Text Void) (SizedList' (ToPeano n) TezosMutez)
-> Either FeeParserException (SizedList' (ToPeano n) TezosMutez)
forall a b. (a -> b) -> a -> b
$
  Parsec Void Text (SizedList' (ToPeano n) TezosMutez)
-> String
-> Text
-> Either
     (ParseErrorBundle Text Void) (SizedList' (ToPeano n) TezosMutez)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.parse (forall (n :: Nat) (m :: * -> *) a.
(SingIPeano n, Applicative m) =>
m a -> m (SizedList n a)
count @n ParsecT Void Text Identity TezosMutez
bakerFeeParser) String
"" Text
output
  where
    bakerFeeParser :: Parser TezosMutez
    bakerFeeParser :: ParsecT Void Text Identity TezosMutez
bakerFeeParser = do
      Scientific
num <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Scientific
-> ParsecT Void Text Identity Scientific
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m end
P.skipManyTill (ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
printChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline) (ParsecT Void Text Identity Scientific
 -> ParsecT Void Text Identity Scientific)
-> ParsecT Void Text Identity Scientific
-> ParsecT Void Text Identity Scientific
forall a b. (a -> b) -> a -> b
$ do
        ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
symbol ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space Tokens Text
"Fee to the baker: "
        ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Scientific
-> ParsecT Void Text Identity Scientific
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m end
P.skipManyTill ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
printChar (ParsecT Void Text Identity Scientific
 -> ParsecT Void Text Identity Scientific)
-> ParsecT Void Text Identity Scientific
-> ParsecT Void Text Identity Scientific
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Scientific
-> ParsecT Void Text Identity Scientific
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
lexeme (ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline ParsecT Void Text Identity Char
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity ()
forall (f :: * -> *). Applicative f => f ()
pass) ParsecT Void Text Identity Scientific
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Scientific
scientific
      Either Text TezosMutez -> ParsecT Void Text Identity TezosMutez
forall (m :: * -> *) a b.
(MonadFail m, Buildable a) =>
Either a b -> m b
Unsafe.unsafeM (Either Text TezosMutez -> ParsecT Void Text Identity TezosMutez)
-> Either Text TezosMutez -> ParsecT Void Text Identity TezosMutez
forall a b. (a -> b) -> a -> b
$ Scientific -> Either Text TezosMutez
scientificToMutez Scientific
num
    scientificToMutez :: Scientific -> Either Text TezosMutez
    scientificToMutez :: Scientific -> Either Text TezosMutez
scientificToMutez Scientific
x = (Mutez -> TezosMutez)
-> Either Text Mutez -> Either Text TezosMutez
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Mutez -> TezosMutez
TezosMutez (Either Text Mutez -> Either Text TezosMutez)
-> Either Text Mutez -> Either Text TezosMutez
forall a b. (a -> b) -> a -> b
$ forall i. Integral i => i -> Either Text Mutez
mkMutez @Word64 (Word64 -> Either Text Mutez) -> Word64 -> Either Text Mutez
forall a b. (a -> b) -> a -> b
$ Scientific -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
floor (Scientific -> Word64) -> Scientific -> Word64
forall a b. (a -> b) -> a -> b
$ Scientific
x Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
* Scientific
1e6

parseSecretKeyEncryption
  :: Text -> Either SecretKeyEncryptionParserException SecretKeyEncryption
parseSecretKeyEncryption :: Text
-> Either SecretKeyEncryptionParserException SecretKeyEncryption
parseSecretKeyEncryption Text
output = (ParseErrorBundle Text UnexpectedEncryptionType
 -> SecretKeyEncryptionParserException)
-> Either
     (ParseErrorBundle Text UnexpectedEncryptionType)
     SecretKeyEncryption
-> Either SecretKeyEncryptionParserException SecretKeyEncryption
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseErrorBundle Text UnexpectedEncryptionType
-> SecretKeyEncryptionParserException
SecretKeyEncryptionParserException (Either
   (ParseErrorBundle Text UnexpectedEncryptionType)
   SecretKeyEncryption
 -> Either SecretKeyEncryptionParserException SecretKeyEncryption)
-> Either
     (ParseErrorBundle Text UnexpectedEncryptionType)
     SecretKeyEncryption
-> Either SecretKeyEncryptionParserException SecretKeyEncryption
forall a b. (a -> b) -> a -> b
$
  Parsec UnexpectedEncryptionType Text SecretKeyEncryption
-> String
-> Text
-> Either
     (ParseErrorBundle Text UnexpectedEncryptionType)
     SecretKeyEncryption
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.parse Parsec UnexpectedEncryptionType Text SecretKeyEncryption
secretKeyEncryptionParser String
"" Text
output
  where
    secretKeyEncryptionParser :: P.Parsec UnexpectedEncryptionType Text SecretKeyEncryption
    secretKeyEncryptionParser :: Parsec UnexpectedEncryptionType Text SecretKeyEncryption
secretKeyEncryptionParser = do
      ParsecT UnexpectedEncryptionType Text Identity Char
-> Parsec UnexpectedEncryptionType Text SecretKeyEncryption
-> Parsec UnexpectedEncryptionType Text SecretKeyEncryption
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m end
P.skipManyTill (ParsecT UnexpectedEncryptionType Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
printChar ParsecT UnexpectedEncryptionType Text Identity Char
-> ParsecT UnexpectedEncryptionType Text Identity Char
-> ParsecT UnexpectedEncryptionType Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT UnexpectedEncryptionType Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline) (Parsec UnexpectedEncryptionType Text SecretKeyEncryption
 -> Parsec UnexpectedEncryptionType Text SecretKeyEncryption)
-> Parsec UnexpectedEncryptionType Text SecretKeyEncryption
-> Parsec UnexpectedEncryptionType Text SecretKeyEncryption
forall a b. (a -> b) -> a -> b
$ do
        ParsecT UnexpectedEncryptionType Text Identity ()
-> Tokens Text
-> ParsecT UnexpectedEncryptionType Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
symbol ParsecT UnexpectedEncryptionType Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space Tokens Text
"Secret Key: " ParsecT UnexpectedEncryptionType Text Identity Text
-> Parsec UnexpectedEncryptionType Text SecretKeyEncryption
-> Parsec UnexpectedEncryptionType Text SecretKeyEncryption
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Parsec UnexpectedEncryptionType Text SecretKeyEncryption]
-> Parsec UnexpectedEncryptionType Text SecretKeyEncryption
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
          [ ParsecT UnexpectedEncryptionType Text Identity ()
-> Tokens Text
-> ParsecT UnexpectedEncryptionType Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
symbol ParsecT UnexpectedEncryptionType Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space Tokens Text
"unencrypted" ParsecT UnexpectedEncryptionType Text Identity Text
-> Parsec UnexpectedEncryptionType Text SecretKeyEncryption
-> Parsec UnexpectedEncryptionType Text SecretKeyEncryption
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SecretKeyEncryption
-> Parsec UnexpectedEncryptionType Text SecretKeyEncryption
forall (f :: * -> *) a. Applicative f => a -> f a
pure SecretKeyEncryption
UnencryptedKey
          , ParsecT UnexpectedEncryptionType Text Identity ()
-> Tokens Text
-> ParsecT UnexpectedEncryptionType Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
symbol ParsecT UnexpectedEncryptionType Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space Tokens Text
"encrypted" ParsecT UnexpectedEncryptionType Text Identity Text
-> Parsec UnexpectedEncryptionType Text SecretKeyEncryption
-> Parsec UnexpectedEncryptionType Text SecretKeyEncryption
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SecretKeyEncryption
-> Parsec UnexpectedEncryptionType Text SecretKeyEncryption
forall (f :: * -> *) a. Applicative f => a -> f a
pure SecretKeyEncryption
EncryptedKey
          , ParsecT UnexpectedEncryptionType Text Identity ()
-> Tokens Text
-> ParsecT UnexpectedEncryptionType Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
symbol ParsecT UnexpectedEncryptionType Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space Tokens Text
"ledger" ParsecT UnexpectedEncryptionType Text Identity Text
-> Parsec UnexpectedEncryptionType Text SecretKeyEncryption
-> Parsec UnexpectedEncryptionType Text SecretKeyEncryption
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SecretKeyEncryption
-> Parsec UnexpectedEncryptionType Text SecretKeyEncryption
forall (f :: * -> *) a. Applicative f => a -> f a
pure SecretKeyEncryption
LedgerKey
          , UnexpectedEncryptionType
-> Parsec UnexpectedEncryptionType Text SecretKeyEncryption
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure UnexpectedEncryptionType
UnexpectedEncryptionType
          ]