packages feed

morley-client-0.1.0: src/Morley/Client/TezosClient/Parser.hs

-- 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 Eq

instance Show FeeParserException where
  show (FeeParserException bundle) = errorBundlePretty bundle

instance Exception FeeParserException where
  displayException = show

data SecretKeyEncryptionParserException =
  SecretKeyEncryptionParserException (ParseErrorBundle Text UnexpectedEncryptionType)
  deriving stock Eq

instance Show SecretKeyEncryptionParserException where
  show (SecretKeyEncryptionParserException bundle) = errorBundlePretty bundle

data UnexpectedEncryptionType = UnexpectedEncryptionType
  deriving stock (Eq, Ord, Show)

instance ShowErrorComponent UnexpectedEncryptionType where
  showErrorComponent UnexpectedEncryptionType =
    "Unexpected secret key encryption type occurred"

-- | Function to parse baker fee from given @tezos-client@ output.
parseBakerFeeFromOutput
  :: Text -> Int -> Either FeeParserException [TezosMutez]
parseBakerFeeFromOutput output n = first FeeParserException $
  P.parse (count n bakerFeeParser) "" output
  where
    bakerFeeParser :: Parser TezosMutez
    bakerFeeParser = do
      num <- P.skipManyTill (printChar <|> newline) $ do
        void $ symbol space "Fee to the baker: "
        P.skipManyTill printChar $ lexeme (newline >> pass) scientific
      either (fail . toString) pure $ scientificToMutez num
    scientificToMutez :: Scientific -> Either Text TezosMutez
    scientificToMutez x = fmap TezosMutez . mkMutez @Word64 $ floor $ x * 1e6

parseSecretKeyEncryption
  :: Text -> Either SecretKeyEncryptionParserException SecretKeyEncryption
parseSecretKeyEncryption output = first SecretKeyEncryptionParserException $
  P.parse secretKeyEncryptionParser "" output
  where
    secretKeyEncryptionParser :: P.Parsec UnexpectedEncryptionType Text SecretKeyEncryption
    secretKeyEncryptionParser = do
      P.skipManyTill (printChar <|> newline) $ do
        symbol space "Secret Key: " >> choice
          [ symbol space "unencrypted" >> pure UnencryptedKey
          , symbol space "encrypted" >> pure EncryptedKey
          , symbol space "ledger" >> pure LedgerKey
          , customFailure UnexpectedEncryptionType
          ]