dfinity-radix-tree-0.5.0: test/Types.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS -Wall #-}
{-# OPTIONS -Werror #-}

module Types
   ( Op(..)
   ) where

import Control.Monad (mzero)
import Data.Aeson (FromJSON(..), Object, Value(..))
import Data.ByteString.Base16 (decode, encode)
import Data.ByteString.Char8 (ByteString, unpack)
import Data.HashMap.Strict as HashMap (lookup)
import Data.Text as Text (Text, drop)
import Data.Text.Encoding (encodeUtf8)

data Op
   = Insert ByteString ByteString
   | Delete ByteString
   | Lookup ByteString (Maybe ByteString)
   | Merkleize ByteString

instance FromJSON Op where
   parseJSON = \ case
      Object object -> maybe mzero pure $ parse object
      _ -> mzero

instance Show Op where
   show = \ case
      Insert key value ->
         "Insert" ++ pretty key ++ pretty value
      Delete key ->
         "Delete" ++ pretty key
      Lookup key value ->
         "Lookup" ++ pretty key ++ maybe " null" pretty value
      Merkleize value ->
         "Merkleize" ++ pretty value
      where pretty = mappend " 0x" . unpack . encode

parse :: Object -> Maybe Op
parse object = do
   op <- HashMap.lookup "op" object
   case op of
      "set" -> do
         key <- get "key" object
         value <- get "value" object
         pure $ Insert key value
      "delete" -> do
         key <- get "key" object
         pure $ Delete key
      "get" -> do
         key <- get "key" object
         let value = get "value" object
         pure $ Lookup key value
      "stateRoot" -> do
         value <- get "value" object
         pure $ Merkleize value
      _ -> Nothing

get :: Text -> Object -> Maybe ByteString
get key object = do
   value <- HashMap.lookup key object
   case value of
      String text -> Just $ fst $ decode $ encodeUtf8 $ Text.drop 2 text
      _ -> Nothing