{-# LANGUAGE BangPatterns              #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE LambdaCase                #-}
{-# LANGUAGE NumDecimals               #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE RankNTypes                #-}

module Cardano.Binary.FromCBOR
  ( FromCBOR(..)
  , DecoderError(..)
  , enforceSize
  , matchSize
  , module D
  , fromCBORMaybe
  , decodeListWith
    -- * Helper tools to build instances
  , decodeMapSkel
  )
where

import Cardano.Prelude

import Codec.CBOR.Decoding as D
import Codec.CBOR.ByteArray as BA
import qualified Codec.CBOR.Read as CBOR.Read
import qualified Data.ByteString.Lazy as BS.Lazy
import qualified Data.ByteString.Short as SBS
import qualified Data.ByteString.Short.Internal as SBS
import qualified Data.Primitive.ByteArray as Prim
import Data.Fixed (Fixed(..), Nano, Pico)
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Tagged (Tagged(..))
import Data.Time.Calendar.OrdinalDate ( fromOrdinalDate )
import Data.Time.Clock (NominalDiffTime, UTCTime(..), picosecondsToDiffTime)
import qualified Data.Vector as Vector
import qualified Data.Vector.Generic as Vector.Generic
import Formatting (bprint, int, shown, stext)
import qualified Formatting.Buildable as B (Buildable(..))

{- HLINT ignore "Reduce duplication" -}
{- HLINT ignore "Redundant <$>" -}

--------------------------------------------------------------------------------
-- FromCBOR
--------------------------------------------------------------------------------

class Typeable a => FromCBOR a where
  fromCBOR :: D.Decoder s a

  label :: Proxy a -> Text
  label = TypeRep -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (TypeRep -> Text) -> (Proxy a -> TypeRep) -> Proxy a -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep


--------------------------------------------------------------------------------
-- DecoderError
--------------------------------------------------------------------------------

data DecoderError
  = DecoderErrorCanonicityViolation Text
  | DecoderErrorCustom Text Text
  -- ^ Custom decoding error, usually due to some validation failure
  | DecoderErrorDeserialiseFailure Text CBOR.Read.DeserialiseFailure
  | DecoderErrorEmptyList Text
  | DecoderErrorLeftover Text ByteString
  | DecoderErrorSizeMismatch Text Int Int
  -- ^ A size mismatch @DecoderErrorSizeMismatch label expectedSize actualSize@
  | DecoderErrorUnknownTag Text Word8
  | DecoderErrorVoid
  deriving (DecoderError -> DecoderError -> Bool
(DecoderError -> DecoderError -> Bool)
-> (DecoderError -> DecoderError -> Bool) -> Eq DecoderError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecoderError -> DecoderError -> Bool
$c/= :: DecoderError -> DecoderError -> Bool
== :: DecoderError -> DecoderError -> Bool
$c== :: DecoderError -> DecoderError -> Bool
Eq, Int -> DecoderError -> ShowS
[DecoderError] -> ShowS
DecoderError -> String
(Int -> DecoderError -> ShowS)
-> (DecoderError -> String)
-> ([DecoderError] -> ShowS)
-> Show DecoderError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecoderError] -> ShowS
$cshowList :: [DecoderError] -> ShowS
show :: DecoderError -> String
$cshow :: DecoderError -> String
showsPrec :: Int -> DecoderError -> ShowS
$cshowsPrec :: Int -> DecoderError -> ShowS
Show)

instance Exception DecoderError

instance B.Buildable DecoderError where
  build :: DecoderError -> Builder
build = \case
    DecoderErrorCanonicityViolation Text
lbl ->
      Format Builder (Text -> Builder) -> Text -> Builder
forall a. Format Builder a -> a
bprint (Format (Text -> Builder) (Text -> Builder)
"Canonicity violation while decoding " Format (Text -> Builder) (Text -> Builder)
-> Format Builder (Text -> Builder)
-> Format Builder (Text -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Text -> Builder)
forall r. Format r (Text -> r)
stext) Text
lbl

    DecoderErrorCustom Text
lbl Text
err -> Format Builder (Text -> Text -> Builder) -> Text -> Text -> Builder
forall a. Format Builder a -> a
bprint
      (Format (Text -> Text -> Builder) (Text -> Text -> Builder)
"An error occured while decoding " Format (Text -> Text -> Builder) (Text -> Text -> Builder)
-> Format Builder (Text -> Text -> Builder)
-> Format Builder (Text -> Text -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Text -> Builder) (Text -> Text -> Builder)
forall r. Format r (Text -> r)
stext Format (Text -> Builder) (Text -> Text -> Builder)
-> Format Builder (Text -> Builder)
-> Format Builder (Text -> Text -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Text -> Builder) (Text -> Builder)
".\n"
      Format (Text -> Builder) (Text -> Builder)
-> Format Builder (Text -> Builder)
-> Format Builder (Text -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Text -> Builder) (Text -> Builder)
"Error: " Format (Text -> Builder) (Text -> Builder)
-> Format Builder (Text -> Builder)
-> Format Builder (Text -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Text -> Builder)
forall r. Format r (Text -> r)
stext)
      Text
lbl
      Text
err

    DecoderErrorDeserialiseFailure Text
lbl DeserialiseFailure
failure -> Format Builder (Text -> DeserialiseFailure -> Builder)
-> Text -> DeserialiseFailure -> Builder
forall a. Format Builder a -> a
bprint
      ( Format
  (Text -> DeserialiseFailure -> Builder)
  (Text -> DeserialiseFailure -> Builder)
"Deserialisation failure while decoding " Format
  (Text -> DeserialiseFailure -> Builder)
  (Text -> DeserialiseFailure -> Builder)
-> Format Builder (Text -> DeserialiseFailure -> Builder)
-> Format Builder (Text -> DeserialiseFailure -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (DeserialiseFailure -> Builder)
  (Text -> DeserialiseFailure -> Builder)
forall r. Format r (Text -> r)
stext Format
  (DeserialiseFailure -> Builder)
  (Text -> DeserialiseFailure -> Builder)
-> Format Builder (DeserialiseFailure -> Builder)
-> Format Builder (Text -> DeserialiseFailure -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (DeserialiseFailure -> Builder) (DeserialiseFailure -> Builder)
".\n"
      Format
  (DeserialiseFailure -> Builder) (DeserialiseFailure -> Builder)
-> Format Builder (DeserialiseFailure -> Builder)
-> Format Builder (DeserialiseFailure -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (DeserialiseFailure -> Builder) (DeserialiseFailure -> Builder)
"CBOR failed with error: " Format
  (DeserialiseFailure -> Builder) (DeserialiseFailure -> Builder)
-> Format Builder (DeserialiseFailure -> Builder)
-> Format Builder (DeserialiseFailure -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (DeserialiseFailure -> Builder)
forall a r. Show a => Format r (a -> r)
shown
      )
      Text
lbl
      DeserialiseFailure
failure

    DecoderErrorEmptyList Text
lbl ->
      Format Builder (Text -> Builder) -> Text -> Builder
forall a. Format Builder a -> a
bprint (Format (Text -> Builder) (Text -> Builder)
"Found unexpected empty list while decoding " Format (Text -> Builder) (Text -> Builder)
-> Format Builder (Text -> Builder)
-> Format Builder (Text -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Text -> Builder)
forall r. Format r (Text -> r)
stext) Text
lbl

    DecoderErrorLeftover Text
lbl ByteString
leftover -> Format Builder (Text -> ByteString -> Builder)
-> Text -> ByteString -> Builder
forall a. Format Builder a -> a
bprint
      ( Format
  (Text -> ByteString -> Builder) (Text -> ByteString -> Builder)
"Found unexpected leftover bytes while decoding " Format
  (Text -> ByteString -> Builder) (Text -> ByteString -> Builder)
-> Format Builder (Text -> ByteString -> Builder)
-> Format Builder (Text -> ByteString -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (ByteString -> Builder) (Text -> ByteString -> Builder)
forall r. Format r (Text -> r)
stext Format (ByteString -> Builder) (Text -> ByteString -> Builder)
-> Format Builder (ByteString -> Builder)
-> Format Builder (Text -> ByteString -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (ByteString -> Builder) (ByteString -> Builder)
"./n"
      Format (ByteString -> Builder) (ByteString -> Builder)
-> Format Builder (ByteString -> Builder)
-> Format Builder (ByteString -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (ByteString -> Builder) (ByteString -> Builder)
"Leftover: " Format (ByteString -> Builder) (ByteString -> Builder)
-> Format Builder (ByteString -> Builder)
-> Format Builder (ByteString -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (ByteString -> Builder)
forall a r. Show a => Format r (a -> r)
shown
      )
      Text
lbl
      ByteString
leftover

    DecoderErrorSizeMismatch Text
lbl Int
requested Int
actual -> Format Builder (Text -> Int -> Int -> Builder)
-> Text -> Int -> Int -> Builder
forall a. Format Builder a -> a
bprint
      ( Format
  (Text -> Int -> Int -> Builder) (Text -> Int -> Int -> Builder)
"Size mismatch when decoding " Format
  (Text -> Int -> Int -> Builder) (Text -> Int -> Int -> Builder)
-> Format Builder (Text -> Int -> Int -> Builder)
-> Format Builder (Text -> Int -> Int -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Int -> Int -> Builder) (Text -> Int -> Int -> Builder)
forall r. Format r (Text -> r)
stext Format (Int -> Int -> Builder) (Text -> Int -> Int -> Builder)
-> Format Builder (Int -> Int -> Builder)
-> Format Builder (Text -> Int -> Int -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Int -> Int -> Builder) (Int -> Int -> Builder)
".\n"
      Format (Int -> Int -> Builder) (Int -> Int -> Builder)
-> Format Builder (Int -> Int -> Builder)
-> Format Builder (Int -> Int -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Int -> Int -> Builder) (Int -> Int -> Builder)
"Expected " Format (Int -> Int -> Builder) (Int -> Int -> Builder)
-> Format Builder (Int -> Int -> Builder)
-> Format Builder (Int -> Int -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Int -> Builder) (Int -> Int -> Builder)
forall a r. Integral a => Format r (a -> r)
int Format (Int -> Builder) (Int -> Int -> Builder)
-> Format Builder (Int -> Builder)
-> Format Builder (Int -> Int -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Int -> Builder) (Int -> Builder)
", but found " Format (Int -> Builder) (Int -> Builder)
-> Format Builder (Int -> Builder)
-> Format Builder (Int -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Int -> Builder)
forall a r. Integral a => Format r (a -> r)
int Format Builder (Int -> Builder)
-> Format Builder Builder -> Format Builder (Int -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder Builder
"."
      )
      Text
lbl
      Int
requested
      Int
actual

    DecoderErrorUnknownTag Text
lbl Word8
t ->
      Format Builder (Word8 -> Text -> Builder)
-> Word8 -> Text -> Builder
forall a. Format Builder a -> a
bprint (Format (Word8 -> Text -> Builder) (Word8 -> Text -> Builder)
"Found unknown tag " Format (Word8 -> Text -> Builder) (Word8 -> Text -> Builder)
-> Format Builder (Word8 -> Text -> Builder)
-> Format Builder (Word8 -> Text -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Text -> Builder) (Word8 -> Text -> Builder)
forall a r. Integral a => Format r (a -> r)
int Format (Text -> Builder) (Word8 -> Text -> Builder)
-> Format Builder (Text -> Builder)
-> Format Builder (Word8 -> Text -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Text -> Builder) (Text -> Builder)
" while decoding " Format (Text -> Builder) (Text -> Builder)
-> Format Builder (Text -> Builder)
-> Format Builder (Text -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Text -> Builder)
forall r. Format r (Text -> r)
stext) Word8
t Text
lbl

    DecoderError
DecoderErrorVoid -> Format Builder Builder -> Builder
forall a. Format Builder a -> a
bprint Format Builder Builder
"Attempted to decode Void"


--------------------------------------------------------------------------------
-- Useful primitives
--------------------------------------------------------------------------------

-- | Enforces that the input size is the same as the decoded one, failing in
--   case it's not
enforceSize :: Text -> Int -> D.Decoder s ()
enforceSize :: Text -> Int -> Decoder s ()
enforceSize Text
lbl Int
requestedSize = Decoder s Int
forall s. Decoder s Int
D.decodeListLen Decoder s Int -> (Int -> Decoder s ()) -> Decoder s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Int -> Int -> Decoder s ()
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
lbl Int
requestedSize

-- | Compare two sizes, failing if they are not equal
matchSize :: Text -> Int -> Int -> D.Decoder s ()
matchSize :: Text -> Int -> Int -> Decoder s ()
matchSize Text
lbl Int
requestedSize Int
actualSize =
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
actualSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
requestedSize) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ DecoderError -> Decoder s ()
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s ()) -> DecoderError -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Int -> DecoderError
DecoderErrorSizeMismatch
    Text
lbl
    Int
requestedSize
    Int
actualSize

-- | @'D.Decoder'@ for list.
decodeListWith :: D.Decoder s a -> D.Decoder s [a]
decodeListWith :: Decoder s a -> Decoder s [a]
decodeListWith Decoder s a
d = do
  Decoder s ()
forall s. Decoder s ()
D.decodeListLenIndef
  ([a] -> a -> [a])
-> [a] -> ([a] -> [a]) -> Decoder s a -> Decoder s [a]
forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
D.decodeSequenceLenIndef ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [a] -> [a]
forall a. [a] -> [a]
reverse Decoder s a
d


--------------------------------------------------------------------------------
-- Primitive types
--------------------------------------------------------------------------------

instance FromCBOR () where
  fromCBOR :: Decoder s ()
fromCBOR = Decoder s ()
forall s. Decoder s ()
D.decodeNull

instance FromCBOR Bool where
  fromCBOR :: Decoder s Bool
fromCBOR = Decoder s Bool
forall s. Decoder s Bool
D.decodeBool


--------------------------------------------------------------------------------
-- Numeric data
--------------------------------------------------------------------------------

instance FromCBOR Integer where
  fromCBOR :: Decoder s Integer
fromCBOR = Decoder s Integer
forall s. Decoder s Integer
D.decodeInteger

instance FromCBOR Word where
  fromCBOR :: Decoder s Word
fromCBOR = Decoder s Word
forall s. Decoder s Word
D.decodeWord

instance FromCBOR Word8 where
  fromCBOR :: Decoder s Word8
fromCBOR = Decoder s Word8
forall s. Decoder s Word8
D.decodeWord8

instance FromCBOR Word16 where
  fromCBOR :: Decoder s Word16
fromCBOR = Decoder s Word16
forall s. Decoder s Word16
D.decodeWord16

instance FromCBOR Word32 where
  fromCBOR :: Decoder s Word32
fromCBOR = Decoder s Word32
forall s. Decoder s Word32
D.decodeWord32

instance FromCBOR Word64 where
  fromCBOR :: Decoder s Word64
fromCBOR = Decoder s Word64
forall s. Decoder s Word64
D.decodeWord64

instance FromCBOR Int where
  fromCBOR :: Decoder s Int
fromCBOR = Decoder s Int
forall s. Decoder s Int
D.decodeInt

instance FromCBOR Float where
  fromCBOR :: Decoder s Float
fromCBOR = Decoder s Float
forall s. Decoder s Float
D.decodeFloat

instance FromCBOR Int32 where
  fromCBOR :: Decoder s Int32
fromCBOR = Decoder s Int32
forall s. Decoder s Int32
D.decodeInt32

instance FromCBOR Int64 where
  fromCBOR :: Decoder s Int64
fromCBOR = Decoder s Int64
forall s. Decoder s Int64
D.decodeInt64

instance (Integral a, FromCBOR a) => FromCBOR (Ratio a) where
  fromCBOR :: Decoder s (Ratio a)
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"Ratio" Int
2
    a
n <- Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR
    a
d <- Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR
    if a
d a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0
      then DecoderError -> Decoder s (Ratio a)
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s (Ratio a))
-> DecoderError -> Decoder s (Ratio a)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"Ratio" Text
"invalid denominator"
      else Ratio a -> Decoder s (Ratio a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ratio a -> Decoder s (Ratio a)) -> Ratio a -> Decoder s (Ratio a)
forall a b. (a -> b) -> a -> b
$! a
n a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
% a
d

instance FromCBOR Nano where
  fromCBOR :: Decoder s Nano
fromCBOR = Integer -> Nano
forall k (a :: k). Integer -> Fixed a
MkFixed (Integer -> Nano) -> Decoder s Integer -> Decoder s Nano
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance FromCBOR Pico where
  fromCBOR :: Decoder s Pico
fromCBOR = Integer -> Pico
forall k (a :: k). Integer -> Fixed a
MkFixed (Integer -> Pico) -> Decoder s Integer -> Decoder s Pico
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall a s. FromCBOR a => Decoder s a
fromCBOR

-- | For backwards compatibility we round pico precision to micro
instance FromCBOR NominalDiffTime where
  fromCBOR :: Decoder s NominalDiffTime
fromCBOR = Rational -> NominalDiffTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> NominalDiffTime)
-> (Integer -> Rational) -> Integer -> NominalDiffTime
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1e6) (Integer -> NominalDiffTime)
-> Decoder s Integer -> Decoder s NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance FromCBOR Natural where
  fromCBOR :: Decoder s Natural
fromCBOR = do
      !Integer
n <- Decoder s Integer
forall a s. FromCBOR a => Decoder s a
fromCBOR
      if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0
        then Natural -> Decoder s Natural
forall (m :: * -> *) a. Monad m => a -> m a
return (Natural -> Decoder s Natural) -> Natural -> Decoder s Natural
forall a b. (a -> b) -> a -> b
$! Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
n
        else DecoderError -> Decoder s Natural
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s Natural)
-> DecoderError -> Decoder s Natural
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"Natural" Text
"got a negative number"

instance FromCBOR Void where
  fromCBOR :: Decoder s Void
fromCBOR = DecoderError -> Decoder s Void
forall e s a. Buildable e => e -> Decoder s a
cborError DecoderError
DecoderErrorVoid


--------------------------------------------------------------------------------
-- Tagged
--------------------------------------------------------------------------------

instance (Typeable s, FromCBOR a) => FromCBOR (Tagged s a) where
  fromCBOR :: Decoder s (Tagged s a)
fromCBOR = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Tagged s a) -> Decoder s a -> Decoder s (Tagged s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR


--------------------------------------------------------------------------------
-- Containers
--------------------------------------------------------------------------------

instance (FromCBOR a, FromCBOR b) => FromCBOR (a,b) where
  fromCBOR :: Decoder s (a, b)
fromCBOR = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
D.decodeListLenOf Int
2
    !a
x <- Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR
    !b
y <- Decoder s b
forall a s. FromCBOR a => Decoder s a
fromCBOR
    (a, b) -> Decoder s (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, b
y)

instance (FromCBOR a, FromCBOR b, FromCBOR c) => FromCBOR (a,b,c) where

  fromCBOR :: Decoder s (a, b, c)
fromCBOR = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
D.decodeListLenOf Int
3
    !a
x <- Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR
    !b
y <- Decoder s b
forall a s. FromCBOR a => Decoder s a
fromCBOR
    !c
z <- Decoder s c
forall a s. FromCBOR a => Decoder s a
fromCBOR
    (a, b, c) -> Decoder s (a, b, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, b
y, c
z)

instance (FromCBOR a, FromCBOR b, FromCBOR c, FromCBOR d) => FromCBOR (a,b,c,d) where
  fromCBOR :: Decoder s (a, b, c, d)
fromCBOR = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
D.decodeListLenOf Int
4
    !a
a <- Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR
    !b
b <- Decoder s b
forall a s. FromCBOR a => Decoder s a
fromCBOR
    !c
c <- Decoder s c
forall a s. FromCBOR a => Decoder s a
fromCBOR
    !d
d <- Decoder s d
forall a s. FromCBOR a => Decoder s a
fromCBOR
    (a, b, c, d) -> Decoder s (a, b, c, d)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b, c
c, d
d)

instance
  (FromCBOR a, FromCBOR b, FromCBOR c, FromCBOR d, FromCBOR e)
  => FromCBOR (a, b, c, d, e)
 where
  fromCBOR :: Decoder s (a, b, c, d, e)
fromCBOR = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
D.decodeListLenOf Int
5
    !a
a <- Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR
    !b
b <- Decoder s b
forall a s. FromCBOR a => Decoder s a
fromCBOR
    !c
c <- Decoder s c
forall a s. FromCBOR a => Decoder s a
fromCBOR
    !d
d <- Decoder s d
forall a s. FromCBOR a => Decoder s a
fromCBOR
    !e
e <- Decoder s e
forall a s. FromCBOR a => Decoder s a
fromCBOR
    (a, b, c, d, e) -> Decoder s (a, b, c, d, e)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b, c
c, d
d, e
e)

instance
  ( FromCBOR a
  , FromCBOR b
  , FromCBOR c
  , FromCBOR d
  , FromCBOR e
  , FromCBOR f
  , FromCBOR g
  )
  => FromCBOR (a, b, c, d, e, f, g)
  where
  fromCBOR :: Decoder s (a, b, c, d, e, f, g)
fromCBOR = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
D.decodeListLenOf Int
7
    !a
a <- Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR
    !b
b <- Decoder s b
forall a s. FromCBOR a => Decoder s a
fromCBOR
    !c
c <- Decoder s c
forall a s. FromCBOR a => Decoder s a
fromCBOR
    !d
d <- Decoder s d
forall a s. FromCBOR a => Decoder s a
fromCBOR
    !e
e <- Decoder s e
forall a s. FromCBOR a => Decoder s a
fromCBOR
    !f
f <- Decoder s f
forall a s. FromCBOR a => Decoder s a
fromCBOR
    !g
g <- Decoder s g
forall a s. FromCBOR a => Decoder s a
fromCBOR
    (a, b, c, d, e, f, g) -> Decoder s (a, b, c, d, e, f, g)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b, c
c, d
d, e
e, f
f, g
g)

instance FromCBOR ByteString where
  fromCBOR :: Decoder s ByteString
fromCBOR = Decoder s ByteString
forall s. Decoder s ByteString
D.decodeBytes

instance FromCBOR Text where
  fromCBOR :: Decoder s Text
fromCBOR = Decoder s Text
forall s. Decoder s Text
D.decodeString

instance FromCBOR LByteString where
  fromCBOR :: Decoder s LByteString
fromCBOR = ByteString -> LByteString
BS.Lazy.fromStrict (ByteString -> LByteString)
-> Decoder s ByteString -> Decoder s LByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance FromCBOR SBS.ShortByteString where
  fromCBOR :: Decoder s ShortByteString
fromCBOR = do
    BA.BA (Prim.ByteArray ByteArray#
ba) <- Decoder s ByteArray
forall s. Decoder s ByteArray
D.decodeByteArray
    ShortByteString -> Decoder s ShortByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ShortByteString -> Decoder s ShortByteString)
-> ShortByteString -> Decoder s ShortByteString
forall a b. (a -> b) -> a -> b
$ ByteArray# -> ShortByteString
SBS.SBS ByteArray#
ba

instance FromCBOR a => FromCBOR [a] where
  fromCBOR :: Decoder s [a]
fromCBOR = Decoder s a -> Decoder s [a]
forall s a. Decoder s a -> Decoder s [a]
decodeListWith Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance (FromCBOR a, FromCBOR b) => FromCBOR (Either a b) where
  fromCBOR :: Decoder s (Either a b)
fromCBOR = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
D.decodeListLenOf Int
2
    Word
t <- Decoder s Word
forall s. Decoder s Word
D.decodeWord
    case Word
t of
      Word
0 -> do
        !a
x <- Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Either a b -> Decoder s (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either a b
forall a b. a -> Either a b
Left a
x)
      Word
1 -> do
        !b
x <- Decoder s b
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Either a b -> Decoder s (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either a b
forall a b. b -> Either a b
Right b
x)
      Word
_ -> DecoderError -> Decoder s (Either a b)
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s (Either a b))
-> DecoderError -> Decoder s (Either a b)
forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"Either" (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
t)

instance FromCBOR a => FromCBOR (NonEmpty a) where
  fromCBOR :: Decoder s (NonEmpty a)
fromCBOR = [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([a] -> Maybe (NonEmpty a))
-> Decoder s [a] -> Decoder s (Maybe (NonEmpty a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s [a]
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Maybe (NonEmpty a))
-> (Maybe (NonEmpty a) -> Decoder s (NonEmpty a))
-> Decoder s (NonEmpty a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either DecoderError (NonEmpty a) -> Decoder s (NonEmpty a)
forall e a s. Buildable e => Either e a -> Decoder s a
toCborError (Either DecoderError (NonEmpty a) -> Decoder s (NonEmpty a))
-> (Maybe (NonEmpty a) -> Either DecoderError (NonEmpty a))
-> Maybe (NonEmpty a)
-> Decoder s (NonEmpty a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. \case
    Maybe (NonEmpty a)
Nothing -> DecoderError -> Either DecoderError (NonEmpty a)
forall a b. a -> Either a b
Left (DecoderError -> Either DecoderError (NonEmpty a))
-> DecoderError -> Either DecoderError (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ Text -> DecoderError
DecoderErrorEmptyList Text
"NonEmpty"
    Just NonEmpty a
xs -> NonEmpty a -> Either DecoderError (NonEmpty a)
forall a b. b -> Either a b
Right NonEmpty a
xs

instance FromCBOR a => FromCBOR (Maybe a) where
  fromCBOR :: Decoder s (Maybe a)
fromCBOR = Decoder s a -> Decoder s (Maybe a)
forall s a. Decoder s a -> Decoder s (Maybe a)
fromCBORMaybe Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR

fromCBORMaybe :: D.Decoder s a -> D.Decoder s (Maybe a)
fromCBORMaybe :: Decoder s a -> Decoder s (Maybe a)
fromCBORMaybe Decoder s a
fromCBORA = do
  Int
n <- Decoder s Int
forall s. Decoder s Int
D.decodeListLen
  case Int
n of
    Int
0 -> Maybe a -> Decoder s (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    Int
1 -> do
      !a
x <- Decoder s a
fromCBORA
      Maybe a -> Decoder s (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
    Int
_ -> DecoderError -> Decoder s (Maybe a)
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s (Maybe a))
-> DecoderError -> Decoder s (Maybe a)
forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"Maybe" (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)

decodeContainerSkelWithReplicate
  :: FromCBOR a
  => D.Decoder s Int
  -- ^ How to get the size of the container
  -> (Int -> D.Decoder s a -> D.Decoder s container)
  -- ^ replicateM for the container
  -> ([container] -> container)
  -- ^ concat for the container
  -> D.Decoder s container
decodeContainerSkelWithReplicate :: Decoder s Int
-> (Int -> Decoder s a -> Decoder s container)
-> ([container] -> container)
-> Decoder s container
decodeContainerSkelWithReplicate Decoder s Int
decodeLen Int -> Decoder s a -> Decoder s container
replicateFun [container] -> container
fromList = do
  -- Look at how much data we have at the moment and use it as the limit for
  -- the size of a single call to replicateFun. We don't want to use
  -- replicateFun directly on the result of decodeLen since this might lead to
  -- DOS attack (attacker providing a huge value for length). So if it's above
  -- our limit, we'll do manual chunking and then combine the containers into
  -- one.
  Int
size  <- Decoder s Int
decodeLen
  Int
limit <- Decoder s Int
forall s. Decoder s Int
D.peekAvailable
  if Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
limit
    then Int -> Decoder s a -> Decoder s container
replicateFun Int
size Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR
    else do
        -- Take the max of limit and a fixed chunk size (note: limit can be
        -- 0). This basically means that the attacker can make us allocate a
        -- container of size 128 even though there's no actual input.
      let
        chunkSize :: Int
chunkSize = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
limit Int
128
        (Int
d, Int
m)    = Int
size Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
chunkSize
        buildOne :: Int -> Decoder s container
buildOne Int
s = Int -> Decoder s a -> Decoder s container
replicateFun Int
s Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR
      [container]
containers <- [Decoder s container] -> Decoder s [container]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Decoder s container] -> Decoder s [container])
-> [Decoder s container] -> Decoder s [container]
forall a b. (a -> b) -> a -> b
$ Int -> Decoder s container
buildOne Int
m Decoder s container
-> [Decoder s container] -> [Decoder s container]
forall a. a -> [a] -> [a]
: Int -> Decoder s container -> [Decoder s container]
forall a. Int -> a -> [a]
replicate Int
d (Int -> Decoder s container
buildOne Int
chunkSize)
      container -> Decoder s container
forall (m :: * -> *) a. Monad m => a -> m a
return (container -> Decoder s container)
-> container -> Decoder s container
forall a b. (a -> b) -> a -> b
$! [container] -> container
fromList [container]
containers
{-# INLINE decodeContainerSkelWithReplicate #-}

-- | Checks canonicity by comparing the new key being decoded with
--   the previous one, to enfore these are sorted the correct way.
--   See: https://tools.ietf.org/html/rfc7049#section-3.9
--   "[..]The keys in every map must be sorted lowest value to highest.[...]"
decodeMapSkel
  :: (Ord k, FromCBOR k, FromCBOR v) => ([(k, v)] -> m) -> D.Decoder s m
decodeMapSkel :: ([(k, v)] -> m) -> Decoder s m
decodeMapSkel [(k, v)] -> m
fromDistinctAscList = do
  Int
n <- Decoder s Int
forall s. Decoder s Int
D.decodeMapLen
  case Int
n of
    Int
0 -> m -> Decoder s m
forall (m :: * -> *) a. Monad m => a -> m a
return ([(k, v)] -> m
fromDistinctAscList [])
    Int
_ -> do
      (k
firstKey, v
firstValue) <- Decoder s (k, v)
forall k v s. (FromCBOR k, FromCBOR v) => Decoder s (k, v)
decodeEntry
      [(k, v)] -> m
fromDistinctAscList
        ([(k, v)] -> m) -> Decoder s [(k, v)] -> Decoder s m
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> k -> [(k, v)] -> Decoder s [(k, v)]
forall k v s.
(FromCBOR k, FromCBOR v, Ord k) =>
Int -> k -> [(k, v)] -> Decoder s [(k, v)]
decodeEntries (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) k
firstKey [(k
firstKey, v
firstValue)]
 where
    -- Decode a single (k,v).
  decodeEntry :: (FromCBOR k, FromCBOR v) => D.Decoder s (k, v)
  decodeEntry :: Decoder s (k, v)
decodeEntry = do
    !k
k <- Decoder s k
forall a s. FromCBOR a => Decoder s a
fromCBOR
    !v
v <- Decoder s v
forall a s. FromCBOR a => Decoder s a
fromCBOR
    (k, v) -> Decoder s (k, v)
forall (m :: * -> *) a. Monad m => a -> m a
return (k
k, v
v)

  -- Decode all the entries, enforcing canonicity by ensuring that the
  -- previous key is smaller than the next one.
  decodeEntries
    :: (FromCBOR k, FromCBOR v, Ord k)
    => Int
    -> k
    -> [(k, v)]
    -> D.Decoder s [(k, v)]
  decodeEntries :: Int -> k -> [(k, v)] -> Decoder s [(k, v)]
decodeEntries Int
0               k
_           [(k, v)]
acc  = [(k, v)] -> Decoder s [(k, v)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(k, v)] -> Decoder s [(k, v)]) -> [(k, v)] -> Decoder s [(k, v)]
forall a b. (a -> b) -> a -> b
$ [(k, v)] -> [(k, v)]
forall a. [a] -> [a]
reverse [(k, v)]
acc
  decodeEntries !Int
remainingPairs k
previousKey ![(k, v)]
acc = do
    p :: (k, v)
p@(k
newKey, v
_) <- Decoder s (k, v)
forall k v s. (FromCBOR k, FromCBOR v) => Decoder s (k, v)
decodeEntry
    -- Order of keys needs to be strictly increasing, because otherwise it's
    -- possible to supply lists with various amount of duplicate keys which
    -- will result in the same map as long as the last value of the given
    -- key on the list is the same in all of them.
    if k
newKey k -> k -> Bool
forall a. Ord a => a -> a -> Bool
> k
previousKey
      then Int -> k -> [(k, v)] -> Decoder s [(k, v)]
forall k v s.
(FromCBOR k, FromCBOR v, Ord k) =>
Int -> k -> [(k, v)] -> Decoder s [(k, v)]
decodeEntries (Int
remainingPairs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) k
newKey ((k, v)
p (k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
: [(k, v)]
acc)
      else DecoderError -> Decoder s [(k, v)]
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s [(k, v)])
-> DecoderError -> Decoder s [(k, v)]
forall a b. (a -> b) -> a -> b
$ Text -> DecoderError
DecoderErrorCanonicityViolation Text
"Map"
{-# INLINE decodeMapSkel #-}

instance (Ord k, FromCBOR k, FromCBOR v) => FromCBOR (Map k v) where
  fromCBOR :: Decoder s (Map k v)
fromCBOR = ([(k, v)] -> Map k v) -> Decoder s (Map k v)
forall k v m s.
(Ord k, FromCBOR k, FromCBOR v) =>
([(k, v)] -> m) -> Decoder s m
decodeMapSkel [(k, v)] -> Map k v
forall k a. [(k, a)] -> Map k a
M.fromDistinctAscList

-- We stitch a `258` in from of a (Hash)Set, so that tools which
-- programmatically check for canonicity can recognise it from a normal
-- array. Why 258? This will be formalised pretty soon, but IANA allocated
-- 256...18446744073709551615 to "First come, first served":
-- https://www.iana.org/assignments/cbor-tags/cbor-tags.xhtml Currently `258` is
-- the first unassigned tag and as it requires 2 bytes to be encoded, it sounds
-- like the best fit.
setTag :: Word
setTag :: Word
setTag = Word
258

decodeSetTag :: D.Decoder s ()
decodeSetTag :: Decoder s ()
decodeSetTag = do
  Word
t <- Decoder s Word
forall s. Decoder s Word
D.decodeTag
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
t Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
setTag) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ DecoderError -> Decoder s ()
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s ()) -> DecoderError -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"Set" (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
t)

decodeSetSkel :: (Ord a, FromCBOR a) => ([a] -> c) -> D.Decoder s c
decodeSetSkel :: ([a] -> c) -> Decoder s c
decodeSetSkel [a] -> c
fromDistinctAscList = do
  Decoder s ()
forall s. Decoder s ()
decodeSetTag
  Int
n <- Decoder s Int
forall s. Decoder s Int
D.decodeListLen
  case Int
n of
    Int
0 -> c -> Decoder s c
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> c
fromDistinctAscList [])
    Int
_ -> do
      a
firstValue <- Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR
      [a] -> c
fromDistinctAscList ([a] -> c) -> Decoder s [a] -> Decoder s c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> [a] -> Decoder s [a]
forall v s. (FromCBOR v, Ord v) => Int -> v -> [v] -> Decoder s [v]
decodeEntries (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a
firstValue [a
firstValue]
 where
  decodeEntries :: (FromCBOR v, Ord v) => Int -> v -> [v] -> D.Decoder s [v]
  decodeEntries :: Int -> v -> [v] -> Decoder s [v]
decodeEntries Int
0                 v
_             [v]
acc  = [v] -> Decoder s [v]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([v] -> Decoder s [v]) -> [v] -> Decoder s [v]
forall a b. (a -> b) -> a -> b
$ [v] -> [v]
forall a. [a] -> [a]
reverse [v]
acc
  decodeEntries !Int
remainingEntries v
previousValue ![v]
acc = do
    v
newValue <- Decoder s v
forall a s. FromCBOR a => Decoder s a
fromCBOR
    -- Order of values needs to be strictly increasing, because otherwise
    -- it's possible to supply lists with various amount of duplicates which
    -- will result in the same set.
    if v
newValue v -> v -> Bool
forall a. Ord a => a -> a -> Bool
> v
previousValue
      then Int -> v -> [v] -> Decoder s [v]
forall v s. (FromCBOR v, Ord v) => Int -> v -> [v] -> Decoder s [v]
decodeEntries (Int
remainingEntries Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) v
newValue (v
newValue v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
acc)
      else DecoderError -> Decoder s [v]
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s [v]) -> DecoderError -> Decoder s [v]
forall a b. (a -> b) -> a -> b
$ Text -> DecoderError
DecoderErrorCanonicityViolation Text
"Set"
{-# INLINE decodeSetSkel #-}

instance (Ord a, FromCBOR a) => FromCBOR (Set a) where
  fromCBOR :: Decoder s (Set a)
fromCBOR = ([a] -> Set a) -> Decoder s (Set a)
forall a c s. (Ord a, FromCBOR a) => ([a] -> c) -> Decoder s c
decodeSetSkel [a] -> Set a
forall a. [a] -> Set a
S.fromDistinctAscList

-- | Generic decoder for vectors. Its intended use is to allow easy
-- definition of 'Serialise' instances for custom vector
decodeVector :: (FromCBOR a, Vector.Generic.Vector v a) => D.Decoder s (v a)
decodeVector :: Decoder s (v a)
decodeVector = Decoder s Int
-> (Int -> Decoder s a -> Decoder s (v a))
-> ([v a] -> v a)
-> Decoder s (v a)
forall a s container.
FromCBOR a =>
Decoder s Int
-> (Int -> Decoder s a -> Decoder s container)
-> ([container] -> container)
-> Decoder s container
decodeContainerSkelWithReplicate
  Decoder s Int
forall s. Decoder s Int
D.decodeListLen
  Int -> Decoder s a -> Decoder s (v a)
forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
Int -> m a -> m (v a)
Vector.Generic.replicateM
  [v a] -> v a
forall (v :: * -> *) a. Vector v a => [v a] -> v a
Vector.Generic.concat
{-# INLINE decodeVector #-}

instance (FromCBOR a) => FromCBOR (Vector.Vector a) where
  fromCBOR :: Decoder s (Vector a)
fromCBOR = Decoder s (Vector a)
forall a (v :: * -> *) s.
(FromCBOR a, Vector v a) =>
Decoder s (v a)
decodeVector
  {-# INLINE fromCBOR #-}


--------------------------------------------------------------------------------
-- Time
--------------------------------------------------------------------------------

instance FromCBOR UTCTime where
  fromCBOR :: Decoder s UTCTime
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"UTCTime" Int
3
    Integer
year <- Decoder s Integer
forall s. Decoder s Integer
decodeInteger
    Int
dayOfYear <- Decoder s Int
forall s. Decoder s Int
decodeInt
    Integer
timeOfDayPico <- Decoder s Integer
forall s. Decoder s Integer
decodeInteger
    UTCTime -> Decoder s UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime -> Decoder s UTCTime) -> UTCTime -> Decoder s UTCTime
forall a b. (a -> b) -> a -> b
$ Day -> DiffTime -> UTCTime
UTCTime
      (Integer -> Int -> Day
fromOrdinalDate Integer
year Int
dayOfYear)
      (Integer -> DiffTime
picosecondsToDiffTime Integer
timeOfDayPico)