Skip to content
2 changes: 1 addition & 1 deletion .hlint.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -61,7 +61,7 @@
- ignore: {name: Use camelCase, within: [Test.Cardano.Api.**, Test.Golden.Cardano.Api.**]}

# Ignore all files in cardano-rpc/gen (generated code)
- ignore: {within: [Proto.Cardano, Proto.Utxorpc]}
- ignore: {within: [Proto.Cardano.**, Proto.Utxorpc.**]}

- ignore: {name: Eta reduce}
- ignore: {name: Use + directly}
Expand Down
47 changes: 36 additions & 11 deletions cardano-api/src/Cardano/Api/Error.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@
module Cardano.Api.Error
( Error (..)
, throwErrorAsException
, liftEitherError
, failEitherError
, ErrorAsException (..)
, FileError (..)
Expand All @@ -20,7 +21,8 @@ where
import Cardano.Api.Monad.Error
import Cardano.Api.Pretty

import Control.Exception (Exception (..), IOException, throwIO)
import Control.Exception.Safe
import GHC.Stack
import System.Directory (doesFileExist)
import System.IO (Handle)

Expand All @@ -32,26 +34,49 @@ instance Error () where

-- | The preferred approach is to use 'Except' or 'ExceptT', but you can if
-- necessary use IO exceptions.
throwErrorAsException :: Error e => e -> IO a
throwErrorAsException e = throwIO (ErrorAsException e)

failEitherError :: MonadFail m => Error e => Either e a -> m a
throwErrorAsException
:: HasCallStack
=> MonadThrow m
=> Typeable e
=> Error e
=> e
-> m a
throwErrorAsException e = withFrozenCallStack $ throwM $ ErrorAsException e

-- | Pretty print 'Error e' and 'fail' if 'Left'.
failEitherError
:: MonadFail m
=> Error e
=> Either e a
-> m a
failEitherError = failEitherWith displayError

-- | Pretty print 'Error e' and 'throwM' it wrapped in 'ErrorAsException' when 'Left'.
liftEitherError
:: HasCallStack
=> MonadThrow m
=> Typeable e
=> Error e
=> Either e a
-> m a
liftEitherError = withFrozenCallStack $ either throwErrorAsException pure

-- | An exception wrapping any 'Error e', attaching a call stack from the construction place to it.
data ErrorAsException where
ErrorAsException :: Error e => e -> ErrorAsException
ErrorAsException :: (HasCallStack, Typeable e, Error e) => e -> ErrorAsException

instance Exception ErrorAsException

-- | Pretty print the error inside the exception
instance Error ErrorAsException where
prettyError (ErrorAsException e) =
prettyError e

-- | Pretty print the error inside the exception followed by the call stack pointing to the place where 'Error e' was
-- wrapped in 'ErrorAsException'
instance Show ErrorAsException where
show (ErrorAsException e) =
docToString $ prettyError e

instance Exception ErrorAsException where
displayException (ErrorAsException e) =
docToString $ prettyError e
docToString (prettyError e) <> "\n" <> prettyCallStack callStack

displayError :: Error a => a -> String
displayError = docToString . prettyError
Expand Down
4 changes: 2 additions & 2 deletions cardano-api/src/Cardano/Api/Experimental/Era.hs
Original file line number Diff line number Diff line change
Expand Up @@ -309,9 +309,9 @@ type EraCommonConstraints era =
, L.EraTxCert (LedgerEra era)
, L.EraTxOut (LedgerEra era)
, L.EraUTxO (LedgerEra era)
, L.Value (LedgerEra era) ~ L.MaryValue
, FromCBOR (ChainDepState (ConsensusProtocol era))
, -- , FromCBOR (L.TxCert (LedgerEra era))
L.NativeScript (LedgerEra era) ~ L.Timelock (LedgerEra era)
, L.NativeScript (LedgerEra era) ~ L.Timelock (LedgerEra era)
, PraosProtocolSupportsNode (ConsensusProtocol era)
, ShelleyLedgerEra era ~ LedgerEra era
, ToJSON (ChainDepState (ConsensusProtocol era))
Expand Down
10 changes: 10 additions & 0 deletions cardano-api/src/Cardano/Api/HasTypeProxy.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,10 +13,12 @@ module Cardano.Api.HasTypeProxy
where

import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BSL
import Data.Kind (Constraint, Type)
import Data.Proxy (Proxy (..))
import Data.Typeable (Typeable)
import Data.Word (Word16, Word8)
import Numeric.Natural (Natural)

class Typeable t => HasTypeProxy t where
-- | A family of singleton types used in this API to indicate which type to
Expand All @@ -35,10 +37,18 @@ instance HasTypeProxy Word16 where
data AsType Word16 = AsWord16
proxyToAsType _ = AsWord16

instance HasTypeProxy Natural where
data AsType Natural = AsNatural
proxyToAsType _ = AsNatural

instance HasTypeProxy BS.ByteString where
data AsType BS.ByteString = AsByteString
proxyToAsType _ = AsByteString

instance HasTypeProxy BSL.ByteString where
data AsType BSL.ByteString = AsByteStringLazy
proxyToAsType _ = AsByteStringLazy

data FromSomeType (c :: Type -> Constraint) b where
FromSomeType :: c a => AsType a -> (a -> b) -> FromSomeType c b

Expand Down
3 changes: 2 additions & 1 deletion cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs
Original file line number Diff line number Diff line change
Expand Up @@ -59,6 +59,7 @@ module Cardano.Api.Ledger.Internal.Reexport
, TxId (..)
, TxIn (..)
, Value
, MaryValue (..)
, MultiAsset (..)
, addDeltaCoin
, castSafeHash
Expand Down Expand Up @@ -343,7 +344,7 @@ import Cardano.Ledger.Keys
, hashWithSerialiser
, toVRFVerKeyHash
)
import Cardano.Ledger.Mary.Value (MultiAsset (..))
import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..))
import Cardano.Ledger.Plutus.Data (Data (..), unData)
import Cardano.Ledger.Plutus.Language (Language, Plutus, languageToText, plutusBinary)
import Cardano.Ledger.Shelley.API
Expand Down
20 changes: 19 additions & 1 deletion cardano-api/src/Cardano/Api/Serialise/Raw.hs
Original file line number Diff line number Diff line change
Expand Up @@ -26,13 +26,17 @@ import Data.Bits (Bits (..))
import Data.ByteString qualified as BS
import Data.ByteString.Base16 qualified as Base16
import Data.ByteString.Builder qualified as BSB
import Data.ByteString.Char8 as BSC
import Data.ByteString.Char8 (ByteString)
import Data.ByteString.Char8 qualified as BSC
import Data.ByteString.Lazy qualified as BSL
import Data.Data (typeRep)
import Data.Foldable qualified as F
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Data.Typeable (TypeRep, Typeable)
import Data.Word (Word16, Word8)
import Numeric.Natural (Natural)

class (HasTypeProxy a, Typeable a) => SerialiseAsRawBytes a where
serialiseToRawBytes :: a -> ByteString
Expand Down Expand Up @@ -60,10 +64,24 @@ instance SerialiseAsRawBytes Word16 where
throwError . SerialiseAsRawBytesError $
"Cannot decode Word16 from (hex): " <> BSC.unpack (Base16.encode bs)

-- | Convert the number into binary value
instance SerialiseAsRawBytes Natural where
serialiseToRawBytes 0 = BS.singleton 0x00
serialiseToRawBytes n = BS.toStrict . BSB.toLazyByteString $ go n mempty
where
go 0 acc = acc
go x acc = go (x `shiftR` 8) (BSB.word8 (fromIntegral (x .&. 0xFF)) <> acc)
deserialiseFromRawBytes AsNatural "\x00" = pure 0
deserialiseFromRawBytes AsNatural input = pure . F.foldl' (\acc byte -> acc `shiftL` 8 .|. fromIntegral byte) 0 $ BS.unpack input

instance SerialiseAsRawBytes BS.ByteString where
serialiseToRawBytes = id
deserialiseFromRawBytes AsByteString = pure

instance SerialiseAsRawBytes BSL.ByteString where
serialiseToRawBytes = BSL.toStrict
deserialiseFromRawBytes AsByteStringLazy = pure . BSL.fromStrict

serialiseToRawBytesHex :: SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex = Base16.encode . serialiseToRawBytes

Expand Down
6 changes: 6 additions & 0 deletions cardano-api/src/Cardano/Api/Serialise/SerialiseUsing.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,8 +17,10 @@ import Cardano.Api.Serialise.Json
import Cardano.Api.Serialise.Raw

import Data.Aeson.Types qualified as Aeson
import Data.ByteString qualified as B
import Data.Text.Encoding qualified as Text
import Data.Typeable (tyConName, typeRep, typeRepTyCon)
import Numeric (showBin)

-- | For use with @deriving via@, to provide 'ToCBOR' and 'FromCBOR' instances,
-- based on the 'SerialiseAsRawBytes' instance.
Expand All @@ -39,6 +41,10 @@ instance SerialiseAsRawBytes a => FromCBOR (UsingRawBytes a) where
ttoken = proxyToAsType (Proxy :: Proxy a)
tname = (tyConName . typeRepTyCon . typeRep) (Proxy :: Proxy a)

-- | Prints the representation in binary format, quoted
instance SerialiseAsRawBytes a => Show (UsingRawBytes a) where
showsPrec _ (UsingRawBytes x) = showChar '"' . mconcat (map showBin . B.unpack $ serialiseToRawBytes x) . showChar '"'

-- | For use with @deriving via@, to provide instances for any\/all of 'Show',
-- 'ToJSON', 'FromJSON', 'ToJSONKey', FromJSONKey' using a hex
-- encoding, based on the 'SerialiseAsRawBytes' instance.
Expand Down
1 change: 0 additions & 1 deletion cardano-api/src/Cardano/Api/Tx/Internal/Fee.hs
Original file line number Diff line number Diff line change
Expand Up @@ -84,7 +84,6 @@ import Cardano.Ledger.Api qualified as L
import Cardano.Ledger.Coin qualified as L
import Cardano.Ledger.Conway.Governance qualified as L
import Cardano.Ledger.Credential as Ledger (Credential)
import Cardano.Ledger.Mary.Value qualified as L
import Cardano.Ledger.Plutus.Language qualified as Plutus
import Cardano.Ledger.Val qualified as L
import Ouroboros.Consensus.HardFork.History qualified as Consensus
Expand Down
2 changes: 1 addition & 1 deletion cardano-rpc/cardano-rpc.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -69,7 +69,6 @@ library
bytestring,
cardano-api >=10.17,
cardano-ledger-api,
cardano-ledger-binary,
cardano-ledger-conway,
cardano-ledger-core,
cardano-rpc:gen,
Expand Down Expand Up @@ -132,3 +131,4 @@ test-suite cardano-rpc-test
build-tool-depends: tasty-discover:tasty-discover
other-modules:
Test.Cardano.Rpc.ProtocolParameters
Test.Cardano.Rpc.TxOutput
Loading
Loading