-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

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

import Data.Scientific (Scientific)
import Text.Megaparsec (choice, count, customFailure)
import qualified Text.Megaparsec 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 qualified Text.Show (show)

import Morley.Client.TezosClient.Types (SecretKeyEncryption(..))
import Morley.Micheline
import Morley.Tezos.Core

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

instance Show FeeParserException where
  show :: FeeParserException -> String
show (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 Exception FeeParserException where
  displayException :: FeeParserException -> String
displayException = FeeParserException -> String
forall b a. (Show a, IsString b) => a -> b
show

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

instance Show SecretKeyEncryptionParserException where
  show :: SecretKeyEncryptionParserException -> String
show (SecretKeyEncryptionParserException ParseErrorBundle Text UnexpectedEncryptionType
bundle) = 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
$cp1Ord :: Eq UnexpectedEncryptionType
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 @tezos-client@ output.
parseBakerFeeFromOutput
  :: Text -> Int -> Either FeeParserException [TezosMutez]
parseBakerFeeFromOutput :: Text -> Int -> Either FeeParserException [TezosMutez]
parseBakerFeeFromOutput Text
output Int
n = (ParseErrorBundle Text Void -> FeeParserException)
-> Either (ParseErrorBundle Text Void) [TezosMutez]
-> Either FeeParserException [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) [TezosMutez]
 -> Either FeeParserException [TezosMutez])
-> Either (ParseErrorBundle Text Void) [TezosMutez]
-> Either FeeParserException [TezosMutez]
forall a b. (a -> b) -> a -> b
$
  Parsec Void Text [TezosMutez]
-> String
-> Text
-> Either (ParseErrorBundle Text Void) [TezosMutez]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.parse (Int
-> ParsecT Void Text Identity TezosMutez
-> Parsec Void Text [TezosMutez]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
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
      (Text -> ParsecT Void Text Identity TezosMutez)
-> (TezosMutez -> ParsecT Void Text Identity TezosMutez)
-> Either Text TezosMutez
-> ParsecT Void Text Identity TezosMutez
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ParsecT Void Text Identity TezosMutez
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT Void Text Identity TezosMutez)
-> (Text -> String)
-> Text
-> ParsecT Void Text Identity TezosMutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString) TezosMutez -> ParsecT Void Text Identity TezosMutez
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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)
-> (Word64 -> Either Text Mutez)
-> Word64
-> Either Text TezosMutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integral Word64, Bits Word64) => Word64 -> Either Text Mutez
forall i. (Integral i, Bits i) => i -> Either Text Mutez
mkMutez @Word64 (Word64 -> Either Text TezosMutez)
-> Word64 -> Either Text TezosMutez
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
          ]