Skip to content

Commit

Permalink
Merge remote-tracking branch 'origin/master' into emmanuel/poll-respo…
Browse files Browse the repository at this point in the history
…nses-from-pact
  • Loading branch information
giantimi committed Dec 8, 2023
2 parents 0c2fb66 + 8d66b53 commit 4d99757
Show file tree
Hide file tree
Showing 6 changed files with 45 additions and 30 deletions.
38 changes: 19 additions & 19 deletions chainweb-api.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -21,24 +21,24 @@ library
-Wincomplete-uni-patterns -Widentities

build-depends:
Decimal >= 0.4.2 && < 0.6
, aeson ^>=1.4
, attoparsec >= 0.13.0.2 && < 0.15
, base >=4.7 && <5
, base16-bytestring ^>=0.1
, base64-bytestring ^>=1.0
, bytestring ^>=0.10
, cereal ^>=0.5
, containers ^>=0.6
, data-default ^>=0.7
, hashable >=1.2 && < 1.4
, readable ^>=0.3
Decimal >= 0.4.2
, aeson >=1.4
, attoparsec >= 0.13.0.2
, base >=4.7 && <5
, base16-bytestring >=0.1
, base64-bytestring >=1.0
, bytestring >=0.10
, cereal >=0.5
, containers >=0.6
, data-default >=0.7
, hashable >=1.2
, readable >=0.3
, scientific
, servant >= 0.16 && < 0.19
, text ^>=1.2
, time >=1.8 && < 1.11
, unordered-containers ^>=0.2
, vector >= 0.11.0.0 && < 0.13
, servant >= 0.16
, text >=1.2
, time >=1.8
, unordered-containers >=0.2
, vector >= 0.11.0.0

if !impl(ghcjs)
build-depends:
Expand Down Expand Up @@ -97,6 +97,6 @@ test-suite testsuite
, bytestring
, cereal
, neat-interpolation >= 0.5
, tasty ^>= 1.2
, tasty-hunit ^>= 0.10
, tasty >= 1.2
, tasty-hunit >= 0.10
, text
11 changes: 11 additions & 0 deletions lib/Chainweb/Api/BytesLE.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
{-# LANGUAGE CPP #-}

module Chainweb.Api.BytesLE where

------------------------------------------------------------------------------
Expand All @@ -16,13 +18,22 @@ newtype BytesLE = BytesLE
{ unBytesLE :: ByteString
} deriving (Eq,Ord,Show)

#if MIN_VERSION_base16_bytestring(1,0,0)
-- Newer version of base16-bytestring
hexToBytesLE :: Text -> Either String BytesLE
hexToBytesLE t = case B16.decode $ T.encodeUtf8 t of
Right decoded -> Right $ BytesLE decoded
Left _ -> Left $ "Invalid hex string: " <> T.unpack t
#else
-- Older version of base16-bytestring
hexToBytesLE :: Text -> Either String BytesLE
hexToBytesLE t =
if B.null invalid
then Right $ BytesLE decoded
else Left $ "Invalid hex string: " <> T.unpack t
where
(decoded, invalid) = B16.decode $ T.encodeUtf8 t
#endif

hexFromBytesLE :: BytesLE -> Text
hexFromBytesLE = T.decodeUtf8 . B16.encode . unBytesLE
Expand Down
3 changes: 2 additions & 1 deletion lib/Chainweb/Api/Guard.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@ import Control.Applicative
import Data.Aeson
import Data.Maybe
import Data.Set (Set)
import Data.String (IsString)
import Data.Text (Text)
------------------------------------------------------------------------------

Expand All @@ -19,7 +20,7 @@ data Guard
| GUser UserGuard
deriving (Eq,Show)

keyNamef :: Text
keyNamef :: IsString s => s
keyNamef = "keysetref"

instance ToJSON Guard where
Expand Down
4 changes: 3 additions & 1 deletion lib/Chainweb/Api/Hash.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,9 @@ import Data.Aeson.Encoding
import Data.Aeson.Types
import Data.ByteString (ByteString)
import qualified Data.ByteString.Base16 as B16
import Data.String (fromString)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
------------------------------------------------------------------------------
import Chainweb.Api.Base64Url
Expand All @@ -18,7 +20,7 @@ newtype Hash = Hash { unHash :: ByteString }
deriving (Eq,Ord,Show,Read)

instance ToJSONKey Hash where
toJSONKey = ToJSONKeyText hashB64U (text . hashB64U)
toJSONKey = ToJSONKeyText (fromString . T.unpack . hashB64U) (text . hashB64U)

instance FromJSONKey Hash where
fromJSONKey = FromJSONKeyTextParser hashParser
Expand Down
13 changes: 7 additions & 6 deletions lib/Chainweb/Api/Payload.hs
Original file line number Diff line number Diff line change
@@ -1,11 +1,11 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Chainweb.Api.Payload where

------------------------------------------------------------------------------
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Data.Text (Text)
------------------------------------------------------------------------------

Expand Down Expand Up @@ -58,11 +58,12 @@ instance ToJSON Payload where
toJSON (ContPayload cont) = Object $ "cont" .= toJSON cont

instance FromJSON Payload where
parseJSON = withObject "Payload" $ \o -> case HM.lookup "exec" o of
Just v | v /= Null -> ExecPayload <$> parseJSON v
_ -> case HM.lookup "cont" o of
Nothing -> fail "Payload must be exec or cont"
Just v -> ContPayload <$> parseJSON v
parseJSON = withObject "Payload" $ \o -> do
o .: "exec" >>= \case
Nothing -> o .: "cont" >>= \case
Nothing -> fail "Payload must be exec or cont"
Just cont -> return $ ContPayload cont
Just exec -> return $ ExecPayload exec

payloadCode :: Payload -> Text
payloadCode (ExecPayload e) = _exec_code e
Expand Down
6 changes: 3 additions & 3 deletions lib/ChainwebData/Pagination.hs
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@ import Data.Aeson
--import Data.ByteString.Lazy (ByteString)
import Data.Default
import Data.Function (on)
import Data.List
import qualified Data.List as List
import Data.Ord
import Data.Map (Map)
import qualified Data.Map as M
Expand Down Expand Up @@ -207,8 +207,8 @@ prune
-> PaginationCache k (PaginationResults v)
-> PaginationCache k (PaginationResults v)
prune n m =
M.fromList $ map g $ groupBy ((==) `on` fst) $ sortBy (comparing fst) $
drop n $ sortBy (comparing $ _prTimestamp . _pvValue . snd) $
M.fromList $ map g $ List.groupBy ((==) `on` fst) $ List.sortBy (comparing fst) $
drop n $ List.sortBy (comparing $ _prTimestamp . _pvValue . snd) $
concatMap f $ M.toList m
where
f (k,vs) = map (k,) vs
Expand Down

0 comments on commit 4d99757

Please sign in to comment.