{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Shelley.Spec.Ledger.Serialization
( ToCBORGroup (..),
FromCBORGroup (..),
CBORGroup (..),
CborSeq (..),
decodeList,
decodeSeq,
decodeStrictSeq,
decodeSet,
decodeMap,
decodeMapContents,
decodeMapTraverse,
decodeMaybe,
decodeRecordNamed,
decodeRecordSum,
decodeNullMaybe,
encodeFoldable,
encodeFoldableEncoder,
encodeFoldableMapEncoder,
encodeNullMaybe,
groupRecord,
ratioToCBOR,
ratioFromCBOR,
mapToCBOR,
mapFromCBOR,
ipv4ToBytes,
ipv4FromBytes,
ipv4ToCBOR,
ipv4FromCBOR,
ipv6ToBytes,
ipv6FromBytes,
ipv6ToCBOR,
ipv6FromCBOR,
listLenInt,
runByteBuilder,
utcTimeToCBOR,
utcTimeFromCBOR,
)
where
import Cardano.Binary
( Decoder,
DecoderError (..),
Encoding,
FromCBOR (..),
Size,
ToCBOR (..),
decodeListLenOrIndef,
decodeMapLenOrIndef,
decodeTag,
encodeBreak,
encodeListLen,
encodeMapLen,
encodeMapLenIndef,
encodeTag,
withWordSize,
)
import Cardano.Prelude (cborError)
import Control.Monad (unless)
import Data.Binary.Get (Get, getWord32le, runGetOrFail)
import Data.Binary.Put (putWord32le, runPut)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BS
import qualified Data.ByteString.Builder.Extra as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Coders
( decodeCollection,
decodeCollectionWithLen,
decodeList,
decodeNullMaybe,
decodeRecordNamed,
decodeRecordSum,
decodeSeq,
decodeSet,
decodeStrictSeq,
encodeFoldable,
encodeFoldableEncoder,
encodeNullMaybe,
wrapCBORArray,
)
import Data.Foldable (foldl')
import Data.Functor.Compose (Compose (..))
import Data.IP
( IPv4,
IPv6,
fromHostAddress,
fromHostAddress6,
toHostAddress,
toHostAddress6,
)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Ratio (Ratio, denominator, numerator, (%))
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time (UTCTime (..))
import Data.Time.Calendar.OrdinalDate (fromOrdinalDate, toOrdinalDate)
import Data.Time.Clock (diffTimeToPicoseconds, picosecondsToDiffTime)
import Data.Typeable
import Network.Socket (HostAddress6)
import Prelude
class Typeable a => ToCBORGroup a where
toCBORGroup :: a -> Encoding
encodedGroupSizeExpr ::
(forall x. ToCBOR x => Proxy x -> Size) ->
Proxy a ->
Size
listLen :: a -> Word
listLenBound :: Proxy a -> Word
listLenInt :: ToCBORGroup a => a -> Int
listLenInt :: a -> Int
listLenInt a
x = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Word
forall a. ToCBORGroup a => a -> Word
listLen a
x)
newtype CBORGroup a = CBORGroup {CBORGroup a -> a
unCBORGroup :: a}
instance ToCBORGroup a => ToCBOR (CBORGroup a) where
toCBOR :: CBORGroup a -> Encoding
toCBOR (CBORGroup a
x) = Word -> Encoding
encodeListLen (a -> Word
forall a. ToCBORGroup a => a -> Word
listLen a
x) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. ToCBORGroup a => a -> Encoding
toCBORGroup a
x
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (CBORGroup a) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy (CBORGroup a)
proxy =
Integer -> Size
forall a. Num a => Integer -> a
fromInteger (Word -> Integer
forall s a. (Integral s, Integral a) => s -> a
withWordSize (Proxy a -> Word
forall a. ToCBORGroup a => Proxy a -> Word
listLenBound Proxy a
proxy'))
Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
forall a.
ToCBORGroup a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedGroupSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy a
proxy'
where
proxy' :: Proxy a
proxy' = CBORGroup a -> a
forall a. CBORGroup a -> a
unCBORGroup (CBORGroup a -> a) -> Proxy (CBORGroup a) -> Proxy a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (CBORGroup a)
proxy
class Typeable a => FromCBORGroup a where
fromCBORGroup :: Decoder s a
instance (FromCBORGroup a, ToCBORGroup a) => FromCBOR (CBORGroup a) where
fromCBOR :: Decoder s (CBORGroup a)
fromCBOR = a -> CBORGroup a
forall a. a -> CBORGroup a
CBORGroup (a -> CBORGroup a) -> Decoder s a -> Decoder s (CBORGroup a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
forall a s. (ToCBORGroup a, FromCBORGroup a) => Decoder s a
groupRecord
groupRecord :: forall a s. (ToCBORGroup a, FromCBORGroup a) => Decoder s a
groupRecord :: Decoder s a
groupRecord = Text -> (a -> Int) -> Decoder s a -> Decoder s a
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"CBORGroup" (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> (a -> Integer) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Integer) -> (a -> Word) -> a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Word
forall a. ToCBORGroup a => a -> Word
listLen) Decoder s a
forall a s. FromCBORGroup a => Decoder s a
fromCBORGroup
mapToCBOR :: (ToCBOR a, ToCBOR b) => Map a b -> Encoding
mapToCBOR :: Map a b -> Encoding
mapToCBOR Map a b
m =
let l :: Word
l = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Map a b -> Int
forall k a. Map k a -> Int
Map.size Map a b
m
contents :: Encoding
contents = (a -> b -> Encoding) -> Map a b -> Encoding
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey (\a
k b
v -> a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR a
k Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> b -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR b
v) Map a b
m
in Word -> Encoding -> Encoding
wrapCBORMap Word
l Encoding
contents
mapFromCBOR :: (Ord a, FromCBOR a, FromCBOR b) => Decoder s (Map a b)
mapFromCBOR :: Decoder s (Map a b)
mapFromCBOR = Decoder s a -> Decoder s b -> Decoder s (Map a b)
forall a s b.
Ord a =>
Decoder s a -> Decoder s b -> Decoder s (Map a b)
decodeMap Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s b
forall a s. FromCBOR a => Decoder s a
fromCBOR
decodeMap :: Ord a => Decoder s a -> Decoder s b -> Decoder s (Map a b)
decodeMap :: Decoder s a -> Decoder s b -> Decoder s (Map a b)
decodeMap Decoder s a
decodeKey Decoder s b
decodeValue =
[(a, b)] -> Map a b
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
([(a, b)] -> Map a b) -> Decoder s [(a, b)] -> Decoder s (Map a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (a, b) -> Decoder s [(a, b)]
forall s a. Decoder s a -> Decoder s [a]
decodeMapContents Decoder s (a, b)
decodePair
where
decodePair :: Decoder s (a, b)
decodePair = (,) (a -> b -> (a, b)) -> Decoder s a -> Decoder s (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
decodeKey Decoder s (b -> (a, b)) -> Decoder s b -> Decoder s (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s b
decodeValue
decodeMapTraverse ::
(Ord a, Applicative t) =>
Decoder s (t a) ->
Decoder s (t b) ->
Decoder s (t (Map a b))
decodeMapTraverse :: Decoder s (t a) -> Decoder s (t b) -> Decoder s (t (Map a b))
decodeMapTraverse Decoder s (t a)
decodeKey Decoder s (t b)
decodeValue =
([(a, b)] -> Map a b) -> t [(a, b)] -> t (Map a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(a, b)] -> Map a b
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (t [(a, b)] -> t (Map a b))
-> ([t (a, b)] -> t [(a, b)]) -> [t (a, b)] -> t (Map a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [t (a, b)] -> t [(a, b)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
([t (a, b)] -> t (Map a b))
-> Decoder s [t (a, b)] -> Decoder s (t (Map a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (t (a, b)) -> Decoder s [t (a, b)]
forall s a. Decoder s a -> Decoder s [a]
decodeMapContents Decoder s (t (a, b))
decodePair
where
decodePair :: Decoder s (t (a, b))
decodePair = Compose (Decoder s) t (a, b) -> Decoder s (t (a, b))
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose (Decoder s) t (a, b) -> Decoder s (t (a, b)))
-> Compose (Decoder s) t (a, b) -> Decoder s (t (a, b))
forall a b. (a -> b) -> a -> b
$ (,) (a -> b -> (a, b))
-> Compose (Decoder s) t a -> Compose (Decoder s) t (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (t a) -> Compose (Decoder s) t a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Decoder s (t a)
decodeKey Compose (Decoder s) t (b -> (a, b))
-> Compose (Decoder s) t b -> Compose (Decoder s) t (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (t b) -> Compose (Decoder s) t b
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Decoder s (t b)
decodeValue
newtype CborSeq a = CborSeq {CborSeq a -> Seq a
unwrapCborSeq :: Seq a}
deriving (a -> CborSeq a -> Bool
CborSeq m -> m
CborSeq a -> [a]
CborSeq a -> Bool
CborSeq a -> Int
CborSeq a -> a
CborSeq a -> a
CborSeq a -> a
CborSeq a -> a
(a -> m) -> CborSeq a -> m
(a -> m) -> CborSeq a -> m
(a -> b -> b) -> b -> CborSeq a -> b
(a -> b -> b) -> b -> CborSeq a -> b
(b -> a -> b) -> b -> CborSeq a -> b
(b -> a -> b) -> b -> CborSeq a -> b
(a -> a -> a) -> CborSeq a -> a
(a -> a -> a) -> CborSeq a -> a
(forall m. Monoid m => CborSeq m -> m)
-> (forall m a. Monoid m => (a -> m) -> CborSeq a -> m)
-> (forall m a. Monoid m => (a -> m) -> CborSeq a -> m)
-> (forall a b. (a -> b -> b) -> b -> CborSeq a -> b)
-> (forall a b. (a -> b -> b) -> b -> CborSeq a -> b)
-> (forall b a. (b -> a -> b) -> b -> CborSeq a -> b)
-> (forall b a. (b -> a -> b) -> b -> CborSeq a -> b)
-> (forall a. (a -> a -> a) -> CborSeq a -> a)
-> (forall a. (a -> a -> a) -> CborSeq a -> a)
-> (forall a. CborSeq a -> [a])
-> (forall a. CborSeq a -> Bool)
-> (forall a. CborSeq a -> Int)
-> (forall a. Eq a => a -> CborSeq a -> Bool)
-> (forall a. Ord a => CborSeq a -> a)
-> (forall a. Ord a => CborSeq a -> a)
-> (forall a. Num a => CborSeq a -> a)
-> (forall a. Num a => CborSeq a -> a)
-> Foldable CborSeq
forall a. Eq a => a -> CborSeq a -> Bool
forall a. Num a => CborSeq a -> a
forall a. Ord a => CborSeq a -> a
forall m. Monoid m => CborSeq m -> m
forall a. CborSeq a -> Bool
forall a. CborSeq a -> Int
forall a. CborSeq a -> [a]
forall a. (a -> a -> a) -> CborSeq a -> a
forall m a. Monoid m => (a -> m) -> CborSeq a -> m
forall b a. (b -> a -> b) -> b -> CborSeq a -> b
forall a b. (a -> b -> b) -> b -> CborSeq a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: CborSeq a -> a
$cproduct :: forall a. Num a => CborSeq a -> a
sum :: CborSeq a -> a
$csum :: forall a. Num a => CborSeq a -> a
minimum :: CborSeq a -> a
$cminimum :: forall a. Ord a => CborSeq a -> a
maximum :: CborSeq a -> a
$cmaximum :: forall a. Ord a => CborSeq a -> a
elem :: a -> CborSeq a -> Bool
$celem :: forall a. Eq a => a -> CborSeq a -> Bool
length :: CborSeq a -> Int
$clength :: forall a. CborSeq a -> Int
null :: CborSeq a -> Bool
$cnull :: forall a. CborSeq a -> Bool
toList :: CborSeq a -> [a]
$ctoList :: forall a. CborSeq a -> [a]
foldl1 :: (a -> a -> a) -> CborSeq a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> CborSeq a -> a
foldr1 :: (a -> a -> a) -> CborSeq a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> CborSeq a -> a
foldl' :: (b -> a -> b) -> b -> CborSeq a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> CborSeq a -> b
foldl :: (b -> a -> b) -> b -> CborSeq a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> CborSeq a -> b
foldr' :: (a -> b -> b) -> b -> CborSeq a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> CborSeq a -> b
foldr :: (a -> b -> b) -> b -> CborSeq a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> CborSeq a -> b
foldMap' :: (a -> m) -> CborSeq a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> CborSeq a -> m
foldMap :: (a -> m) -> CborSeq a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> CborSeq a -> m
fold :: CborSeq m -> m
$cfold :: forall m. Monoid m => CborSeq m -> m
Foldable)
instance ToCBOR a => ToCBOR (CborSeq a) where
toCBOR :: CborSeq a -> Encoding
toCBOR (CborSeq Seq a
xs) =
let l :: Word
l = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
xs
contents :: Encoding
contents = (a -> Encoding) -> Seq a -> Encoding
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Seq a
xs
in Word -> Encoding -> Encoding
wrapCBORArray Word
l Encoding
contents
instance FromCBOR a => FromCBOR (CborSeq a) where
fromCBOR :: Decoder s (CborSeq a)
fromCBOR = Seq a -> CborSeq a
forall a. Seq a -> CborSeq a
CborSeq (Seq a -> CborSeq a) -> Decoder s (Seq a) -> Decoder s (CborSeq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a -> Decoder s (Seq a)
forall s a. Decoder s a -> Decoder s (Seq a)
decodeSeq Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR
encodeFoldableMapEncoder ::
Foldable f =>
(Word -> a -> Maybe Encoding) ->
f a ->
Encoding
encodeFoldableMapEncoder :: (Word -> a -> Maybe Encoding) -> f a -> Encoding
encodeFoldableMapEncoder Word -> a -> Maybe Encoding
encode f a
xs = Word -> Encoding -> Encoding
wrapCBORMap Word
len Encoding
contents
where
(Word
len, Word
_, Encoding
contents) = ((Word, Word, Encoding) -> a -> (Word, Word, Encoding))
-> (Word, Word, Encoding) -> f a -> (Word, Word, Encoding)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Word, Word, Encoding) -> a -> (Word, Word, Encoding)
forall a. Num a => (a, Word, Encoding) -> a -> (a, Word, Encoding)
go (Word
0, Word
0, Encoding
forall a. Monoid a => a
mempty) f a
xs
go :: (a, Word, Encoding) -> a -> (a, Word, Encoding)
go (!a
l, !Word
i, !Encoding
enc) a
next = case Word -> a -> Maybe Encoding
encode Word
i a
next of
Maybe Encoding
Nothing -> (a
l, Word
i Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1, Encoding
enc)
Just Encoding
e -> (a
l a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, Word
i Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1, Encoding
enc Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
e)
wrapCBORMap :: Word -> Encoding -> Encoding
wrapCBORMap :: Word -> Encoding -> Encoding
wrapCBORMap Word
len Encoding
contents =
if Word
len Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
23
then Word -> Encoding
encodeMapLen Word
len Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
contents
else Encoding
encodeMapLenIndef Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
contents Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
encodeBreak
decodeMaybe :: Decoder s a -> Decoder s (Maybe a)
decodeMaybe :: Decoder s a -> Decoder s (Maybe a)
decodeMaybe Decoder s a
d =
Decoder s a -> Decoder s [a]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s a
d Decoder s [a]
-> ([a] -> Decoder s (Maybe a)) -> Decoder s (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[] -> Maybe a -> Decoder s (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
[a
x] -> Maybe a -> Decoder s (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> Decoder s (Maybe a)) -> Maybe a -> Decoder s (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
x
[a]
_ ->
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 -> Text -> DecoderError
DecoderErrorCustom
Text
"Maybe"
Text
"Expected an array of length 0 or 1"
decodeMapContents :: Decoder s a -> Decoder s [a]
decodeMapContents :: Decoder s a -> Decoder s [a]
decodeMapContents = Decoder s (Maybe Int) -> Decoder s a -> Decoder s [a]
forall s a. Decoder s (Maybe Int) -> Decoder s a -> Decoder s [a]
decodeCollection Decoder s (Maybe Int)
forall s. Decoder s (Maybe Int)
decodeMapLenOrIndef
ratioToCBOR :: ToCBOR a => Ratio a -> Encoding
ratioToCBOR :: Ratio a -> Encoding
ratioToCBOR Ratio a
r =
Word -> Encoding
encodeTag Word
30
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeListLen Word
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
r)
ratioFromCBOR :: (Integral a, FromCBOR a) => Decoder s (Ratio a)
ratioFromCBOR :: Decoder s (Ratio a)
ratioFromCBOR = do
Word
t <- Decoder s Word
forall s. Decoder s Word
decodeTag
Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word
t Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
30) (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 -> Text -> DecoderError
DecoderErrorCustom Text
"rational" Text
"expected tag 30"
(Int
numValues, [a]
values) <- Decoder s (Maybe Int) -> Decoder s a -> Decoder s (Int, [a])
forall s a.
Decoder s (Maybe Int) -> Decoder s a -> Decoder s (Int, [a])
decodeCollectionWithLen (Decoder s (Maybe Int)
forall s. Decoder s (Maybe Int)
decodeListLenOrIndef) Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR
case [a]
values of
a
n : a
d : [] -> Ratio a -> Decoder s (Ratio a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
[a]
_ -> 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 -> Int -> Int -> DecoderError
DecoderErrorSizeMismatch Text
"rational" Int
2 Int
numValues
ipv4ToBytes :: IPv4 -> BS.ByteString
ipv4ToBytes :: IPv4 -> ByteString
ipv4ToBytes = ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (IPv4 -> ByteString) -> IPv4 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteString) -> (IPv4 -> Put) -> IPv4 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Put
putWord32le (Word32 -> Put) -> (IPv4 -> Word32) -> IPv4 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> Word32
toHostAddress
ipv4FromBytes :: BS.ByteString -> Either String IPv4
ipv4FromBytes :: ByteString -> Either String IPv4
ipv4FromBytes ByteString
b =
case Get Word32
-> ByteString
-> Either
(ByteString, ByteOffset, String) (ByteString, ByteOffset, Word32)
forall a.
Get a
-> ByteString
-> Either
(ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get Word32
getWord32le (ByteString -> ByteString
BSL.fromStrict ByteString
b) of
Left (ByteString
_, ByteOffset
_, String
err) -> String -> Either String IPv4
forall a b. a -> Either a b
Left (String -> Either String IPv4) -> String -> Either String IPv4
forall a b. (a -> b) -> a -> b
$ String
err
Right (ByteString
_, ByteOffset
_, Word32
ha) -> IPv4 -> Either String IPv4
forall a b. b -> Either a b
Right (IPv4 -> Either String IPv4) -> IPv4 -> Either String IPv4
forall a b. (a -> b) -> a -> b
$ Word32 -> IPv4
fromHostAddress Word32
ha
ipv4ToCBOR :: IPv4 -> Encoding
ipv4ToCBOR :: IPv4 -> Encoding
ipv4ToCBOR = ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ByteString -> Encoding)
-> (IPv4 -> ByteString) -> IPv4 -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> ByteString
ipv4ToBytes
byteDecoderToDecoder :: Text -> (BS.ByteString -> Either String a) -> Decoder s a
byteDecoderToDecoder :: Text -> (ByteString -> Either String a) -> Decoder s a
byteDecoderToDecoder Text
name ByteString -> Either String a
fromBytes = do
ByteString
b <- Decoder s ByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR
case ByteString -> Either String a
fromBytes ByteString
b of
Left String
err -> DecoderError -> Decoder s a
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s a) -> DecoderError -> Decoder s a
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
name (String -> Text
Text.pack String
err)
Right a
ip -> a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
ip
ipv4FromCBOR :: Decoder s IPv4
ipv4FromCBOR :: Decoder s IPv4
ipv4FromCBOR = Text -> (ByteString -> Either String IPv4) -> Decoder s IPv4
forall a s. Text -> (ByteString -> Either String a) -> Decoder s a
byteDecoderToDecoder Text
"IPv4" ByteString -> Either String IPv4
ipv4FromBytes
ipv6ToBytes :: IPv6 -> BS.ByteString
ipv6ToBytes :: IPv6 -> ByteString
ipv6ToBytes IPv6
ipv6 = ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (Put -> ByteString) -> Put -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
let (Word32
w1, Word32
w2, Word32
w3, Word32
w4) = IPv6 -> (Word32, Word32, Word32, Word32)
toHostAddress6 IPv6
ipv6
Word32 -> Put
putWord32le Word32
w1
Word32 -> Put
putWord32le Word32
w2
Word32 -> Put
putWord32le Word32
w3
Word32 -> Put
putWord32le Word32
w4
getHostAddress6 :: Get HostAddress6
getHostAddress6 :: Get (Word32, Word32, Word32, Word32)
getHostAddress6 = do
Word32
w1 <- Get Word32
getWord32le
Word32
w2 <- Get Word32
getWord32le
Word32
w3 <- Get Word32
getWord32le
Word32
w4 <- Get Word32
getWord32le
(Word32, Word32, Word32, Word32)
-> Get (Word32, Word32, Word32, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Word32, Word32, Word32, Word32)
-> Get (Word32, Word32, Word32, Word32))
-> (Word32, Word32, Word32, Word32)
-> Get (Word32, Word32, Word32, Word32)
forall a b. (a -> b) -> a -> b
$ (Word32
w1, Word32
w2, Word32
w3, Word32
w4)
ipv6FromBytes :: BS.ByteString -> Either String IPv6
ipv6FromBytes :: ByteString -> Either String IPv6
ipv6FromBytes ByteString
b =
case Get (Word32, Word32, Word32, Word32)
-> ByteString
-> Either
(ByteString, ByteOffset, String)
(ByteString, ByteOffset, (Word32, Word32, Word32, Word32))
forall a.
Get a
-> ByteString
-> Either
(ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get (Word32, Word32, Word32, Word32)
getHostAddress6 (ByteString -> ByteString
BSL.fromStrict ByteString
b) of
Left (ByteString
_, ByteOffset
_, String
err) -> String -> Either String IPv6
forall a b. a -> Either a b
Left (String -> Either String IPv6) -> String -> Either String IPv6
forall a b. (a -> b) -> a -> b
$ String
err
Right (ByteString
_, ByteOffset
_, (Word32, Word32, Word32, Word32)
ha) -> IPv6 -> Either String IPv6
forall a b. b -> Either a b
Right (IPv6 -> Either String IPv6) -> IPv6 -> Either String IPv6
forall a b. (a -> b) -> a -> b
$ (Word32, Word32, Word32, Word32) -> IPv6
fromHostAddress6 (Word32, Word32, Word32, Word32)
ha
ipv6ToCBOR :: IPv6 -> Encoding
ipv6ToCBOR :: IPv6 -> Encoding
ipv6ToCBOR = ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ByteString -> Encoding)
-> (IPv6 -> ByteString) -> IPv6 -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6 -> ByteString
ipv6ToBytes
ipv6FromCBOR :: Decoder s IPv6
ipv6FromCBOR :: Decoder s IPv6
ipv6FromCBOR = Text -> (ByteString -> Either String IPv6) -> Decoder s IPv6
forall a s. Text -> (ByteString -> Either String a) -> Decoder s a
byteDecoderToDecoder Text
"IPv6" ByteString -> Either String IPv6
ipv6FromBytes
runByteBuilder :: Int -> BS.Builder -> BS.ByteString
runByteBuilder :: Int -> Builder -> ByteString
runByteBuilder !Int
sizeHint =
ByteString -> ByteString
BSL.toStrict
(ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllocationStrategy -> ByteString -> Builder -> ByteString
BS.toLazyByteStringWith
(Int -> Int -> AllocationStrategy
BS.safeStrategy Int
sizeHint (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sizeHint))
ByteString
forall a. Monoid a => a
mempty
{-# NOINLINE runByteBuilder #-}
utcTimeToCBOR :: UTCTime -> Encoding
utcTimeToCBOR :: UTCTime -> Encoding
utcTimeToCBOR UTCTime
t =
Word -> Encoding
encodeListLen Word
3
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Integer -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Integer
year
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Int
dayOfYear
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Integer -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Integer -> Encoding)
-> (UTCTime -> Integer) -> UTCTime -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Integer
diffTimeToPicoseconds (DiffTime -> Integer)
-> (UTCTime -> DiffTime) -> UTCTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> DiffTime
utctDayTime) UTCTime
t
where
(Integer
year, Int
dayOfYear) = Day -> (Integer, Int)
toOrdinalDate (Day -> (Integer, Int))
-> (UTCTime -> Day) -> UTCTime -> (Integer, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Day
utctDay (UTCTime -> (Integer, Int)) -> UTCTime -> (Integer, Int)
forall a b. (a -> b) -> a -> b
$ UTCTime
t
utcTimeFromCBOR :: Decoder s UTCTime
utcTimeFromCBOR :: Decoder s UTCTime
utcTimeFromCBOR = do
Text -> (UTCTime -> Int) -> Decoder s UTCTime -> Decoder s UTCTime
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"UTCTime" (Int -> UTCTime -> Int
forall a b. a -> b -> a
const Int
3) (Decoder s UTCTime -> Decoder s UTCTime)
-> Decoder s UTCTime -> Decoder s UTCTime
forall a b. (a -> b) -> a -> b
$ do
Integer
year <- Decoder s Integer
forall a s. FromCBOR a => Decoder s a
fromCBOR
Int
dayOfYear <- Decoder s Int
forall a s. FromCBOR a => Decoder s a
fromCBOR
Integer
diff <- Decoder s Integer
forall a s. FromCBOR a => Decoder s a
fromCBOR
UTCTime -> Decoder s UTCTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
diff)