{-# LANGUAGE RecordWildCards #-}

module Unison.SyncV2.Types
  ( DownloadEntitiesRequest (..),
    DownloadEntitiesChunk (..),
    EntityChunk (..),
    ErrorChunk (..),
    StreamInitInfo (..),
    SyncError (..),
    DownloadEntitiesError (..),
    CausalDependenciesRequest (..),
    CausalDependenciesChunk (..),
    DependencyType (..),
    CBORBytes (..),
    CBORStream (..),
    EntityKind (..),
    serialiseCBORBytes,
    deserialiseOrFailCBORBytes,
    BranchRef (..),
    PullError (..),
    EntitySorting (..),
    Version (..),
  )
where

import Codec.CBOR.Encoding qualified as CBOR
import Codec.Serialise (Serialise (..))
import Codec.Serialise qualified as CBOR
import Codec.Serialise.Decoding qualified as CBOR
import Control.Exception (Exception)
import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:), (.=))
import Data.Aeson qualified as Aeson
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Set (Set)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Word (Word16, Word64)
import U.Codebase.HashTags (CausalHash)
import U.Codebase.Sqlite.TempEntity (TempEntity)
import Unison.Core.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName)
import Unison.Hash32 (Hash32)
import Unison.Prelude (From (..))
import Unison.Server.Orphans ()
import Unison.Share.API.Hash (HashJWT)
import Unison.Sync.Types qualified as SyncV1
import Unison.Util.Servant.CBOR

newtype BranchRef = BranchRef {BranchRef -> Text
unBranchRef :: Text}
  deriving ([BranchRef] -> Encoding
BranchRef -> Encoding
(BranchRef -> Encoding)
-> (forall s. Decoder s BranchRef)
-> ([BranchRef] -> Encoding)
-> (forall s. Decoder s [BranchRef])
-> Serialise BranchRef
forall s. Decoder s [BranchRef]
forall s. Decoder s BranchRef
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: BranchRef -> Encoding
encode :: BranchRef -> Encoding
$cdecode :: forall s. Decoder s BranchRef
decode :: forall s. Decoder s BranchRef
$cencodeList :: [BranchRef] -> Encoding
encodeList :: [BranchRef] -> Encoding
$cdecodeList :: forall s. Decoder s [BranchRef]
decodeList :: forall s. Decoder s [BranchRef]
Serialise, BranchRef -> BranchRef -> Bool
(BranchRef -> BranchRef -> Bool)
-> (BranchRef -> BranchRef -> Bool) -> Eq BranchRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BranchRef -> BranchRef -> Bool
== :: BranchRef -> BranchRef -> Bool
$c/= :: BranchRef -> BranchRef -> Bool
/= :: BranchRef -> BranchRef -> Bool
Eq, Int -> BranchRef -> ShowS
[BranchRef] -> ShowS
BranchRef -> String
(Int -> BranchRef -> ShowS)
-> (BranchRef -> String)
-> ([BranchRef] -> ShowS)
-> Show BranchRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BranchRef -> ShowS
showsPrec :: Int -> BranchRef -> ShowS
$cshow :: BranchRef -> String
show :: BranchRef -> String
$cshowList :: [BranchRef] -> ShowS
showList :: [BranchRef] -> ShowS
Show, Eq BranchRef
Eq BranchRef =>
(BranchRef -> BranchRef -> Ordering)
-> (BranchRef -> BranchRef -> Bool)
-> (BranchRef -> BranchRef -> Bool)
-> (BranchRef -> BranchRef -> Bool)
-> (BranchRef -> BranchRef -> Bool)
-> (BranchRef -> BranchRef -> BranchRef)
-> (BranchRef -> BranchRef -> BranchRef)
-> Ord BranchRef
BranchRef -> BranchRef -> Bool
BranchRef -> BranchRef -> Ordering
BranchRef -> BranchRef -> BranchRef
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BranchRef -> BranchRef -> Ordering
compare :: BranchRef -> BranchRef -> Ordering
$c< :: BranchRef -> BranchRef -> Bool
< :: BranchRef -> BranchRef -> Bool
$c<= :: BranchRef -> BranchRef -> Bool
<= :: BranchRef -> BranchRef -> Bool
$c> :: BranchRef -> BranchRef -> Bool
> :: BranchRef -> BranchRef -> Bool
$c>= :: BranchRef -> BranchRef -> Bool
>= :: BranchRef -> BranchRef -> Bool
$cmax :: BranchRef -> BranchRef -> BranchRef
max :: BranchRef -> BranchRef -> BranchRef
$cmin :: BranchRef -> BranchRef -> BranchRef
min :: BranchRef -> BranchRef -> BranchRef
Ord, [BranchRef] -> Value
[BranchRef] -> Encoding
BranchRef -> Value
BranchRef -> Encoding
(BranchRef -> Value)
-> (BranchRef -> Encoding)
-> ([BranchRef] -> Value)
-> ([BranchRef] -> Encoding)
-> ToJSON BranchRef
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: BranchRef -> Value
toJSON :: BranchRef -> Value
$ctoEncoding :: BranchRef -> Encoding
toEncoding :: BranchRef -> Encoding
$ctoJSONList :: [BranchRef] -> Value
toJSONList :: [BranchRef] -> Value
$ctoEncodingList :: [BranchRef] -> Encoding
toEncodingList :: [BranchRef] -> Encoding
ToJSON, Value -> Parser [BranchRef]
Value -> Parser BranchRef
(Value -> Parser BranchRef)
-> (Value -> Parser [BranchRef]) -> FromJSON BranchRef
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser BranchRef
parseJSON :: Value -> Parser BranchRef
$cparseJSONList :: Value -> Parser [BranchRef]
parseJSONList :: Value -> Parser [BranchRef]
FromJSON) via Text

instance From (ProjectAndBranch ProjectName ProjectBranchName) BranchRef where
  from :: ProjectAndBranch ProjectName ProjectBranchName -> BranchRef
from ProjectAndBranch ProjectName ProjectBranchName
pab = Text -> BranchRef
BranchRef (Text -> BranchRef) -> Text -> BranchRef
forall a b. (a -> b) -> a -> b
$ ProjectAndBranch ProjectName ProjectBranchName -> Text
forall source target. From source target => source -> target
from ProjectAndBranch ProjectName ProjectBranchName
pab

data GetCausalHashErrorTag
  = GetCausalHashNoReadPermissionTag
  | GetCausalHashUserNotFoundTag
  | GetCausalHashInvalidBranchRefTag
  deriving stock (Int -> GetCausalHashErrorTag -> ShowS
[GetCausalHashErrorTag] -> ShowS
GetCausalHashErrorTag -> String
(Int -> GetCausalHashErrorTag -> ShowS)
-> (GetCausalHashErrorTag -> String)
-> ([GetCausalHashErrorTag] -> ShowS)
-> Show GetCausalHashErrorTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetCausalHashErrorTag -> ShowS
showsPrec :: Int -> GetCausalHashErrorTag -> ShowS
$cshow :: GetCausalHashErrorTag -> String
show :: GetCausalHashErrorTag -> String
$cshowList :: [GetCausalHashErrorTag] -> ShowS
showList :: [GetCausalHashErrorTag] -> ShowS
Show, GetCausalHashErrorTag -> GetCausalHashErrorTag -> Bool
(GetCausalHashErrorTag -> GetCausalHashErrorTag -> Bool)
-> (GetCausalHashErrorTag -> GetCausalHashErrorTag -> Bool)
-> Eq GetCausalHashErrorTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetCausalHashErrorTag -> GetCausalHashErrorTag -> Bool
== :: GetCausalHashErrorTag -> GetCausalHashErrorTag -> Bool
$c/= :: GetCausalHashErrorTag -> GetCausalHashErrorTag -> Bool
/= :: GetCausalHashErrorTag -> GetCausalHashErrorTag -> Bool
Eq, Eq GetCausalHashErrorTag
Eq GetCausalHashErrorTag =>
(GetCausalHashErrorTag -> GetCausalHashErrorTag -> Ordering)
-> (GetCausalHashErrorTag -> GetCausalHashErrorTag -> Bool)
-> (GetCausalHashErrorTag -> GetCausalHashErrorTag -> Bool)
-> (GetCausalHashErrorTag -> GetCausalHashErrorTag -> Bool)
-> (GetCausalHashErrorTag -> GetCausalHashErrorTag -> Bool)
-> (GetCausalHashErrorTag
    -> GetCausalHashErrorTag -> GetCausalHashErrorTag)
-> (GetCausalHashErrorTag
    -> GetCausalHashErrorTag -> GetCausalHashErrorTag)
-> Ord GetCausalHashErrorTag
GetCausalHashErrorTag -> GetCausalHashErrorTag -> Bool
GetCausalHashErrorTag -> GetCausalHashErrorTag -> Ordering
GetCausalHashErrorTag
-> GetCausalHashErrorTag -> GetCausalHashErrorTag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GetCausalHashErrorTag -> GetCausalHashErrorTag -> Ordering
compare :: GetCausalHashErrorTag -> GetCausalHashErrorTag -> Ordering
$c< :: GetCausalHashErrorTag -> GetCausalHashErrorTag -> Bool
< :: GetCausalHashErrorTag -> GetCausalHashErrorTag -> Bool
$c<= :: GetCausalHashErrorTag -> GetCausalHashErrorTag -> Bool
<= :: GetCausalHashErrorTag -> GetCausalHashErrorTag -> Bool
$c> :: GetCausalHashErrorTag -> GetCausalHashErrorTag -> Bool
> :: GetCausalHashErrorTag -> GetCausalHashErrorTag -> Bool
$c>= :: GetCausalHashErrorTag -> GetCausalHashErrorTag -> Bool
>= :: GetCausalHashErrorTag -> GetCausalHashErrorTag -> Bool
$cmax :: GetCausalHashErrorTag
-> GetCausalHashErrorTag -> GetCausalHashErrorTag
max :: GetCausalHashErrorTag
-> GetCausalHashErrorTag -> GetCausalHashErrorTag
$cmin :: GetCausalHashErrorTag
-> GetCausalHashErrorTag -> GetCausalHashErrorTag
min :: GetCausalHashErrorTag
-> GetCausalHashErrorTag -> GetCausalHashErrorTag
Ord)

instance Serialise GetCausalHashErrorTag where
  encode :: GetCausalHashErrorTag -> Encoding
encode GetCausalHashErrorTag
GetCausalHashNoReadPermissionTag = Word8 -> Encoding
CBOR.encodeWord8 Word8
0
  encode GetCausalHashErrorTag
GetCausalHashUserNotFoundTag = Word8 -> Encoding
CBOR.encodeWord8 Word8
1
  encode GetCausalHashErrorTag
GetCausalHashInvalidBranchRefTag = Word8 -> Encoding
CBOR.encodeWord8 Word8
2
  decode :: forall s. Decoder s GetCausalHashErrorTag
decode = do
    Word8
tag <- Decoder s Word8
forall s. Decoder s Word8
CBOR.decodeWord8
    case Word8
tag of
      Word8
0 -> GetCausalHashErrorTag -> Decoder s GetCausalHashErrorTag
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GetCausalHashErrorTag
GetCausalHashNoReadPermissionTag
      Word8
1 -> GetCausalHashErrorTag -> Decoder s GetCausalHashErrorTag
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GetCausalHashErrorTag
GetCausalHashUserNotFoundTag
      Word8
2 -> GetCausalHashErrorTag -> Decoder s GetCausalHashErrorTag
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GetCausalHashErrorTag
GetCausalHashInvalidBranchRefTag
      Word8
_ -> String -> Decoder s GetCausalHashErrorTag
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid tag"

data DownloadEntitiesRequest = DownloadEntitiesRequest
  { DownloadEntitiesRequest -> HashJWT
causalHash :: HashJWT,
    DownloadEntitiesRequest -> BranchRef
branchRef :: BranchRef,
    DownloadEntitiesRequest -> Set Hash32
knownHashes :: Set Hash32
  }

instance Serialise DownloadEntitiesRequest where
  encode :: DownloadEntitiesRequest -> Encoding
encode (DownloadEntitiesRequest {HashJWT
$sel:causalHash:DownloadEntitiesRequest :: DownloadEntitiesRequest -> HashJWT
causalHash :: HashJWT
causalHash, BranchRef
$sel:branchRef:DownloadEntitiesRequest :: DownloadEntitiesRequest -> BranchRef
branchRef :: BranchRef
branchRef, Set Hash32
$sel:knownHashes:DownloadEntitiesRequest :: DownloadEntitiesRequest -> Set Hash32
knownHashes :: Set Hash32
knownHashes}) =
    HashJWT -> Encoding
forall a. Serialise a => a -> Encoding
encode HashJWT
causalHash Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> BranchRef -> Encoding
forall a. Serialise a => a -> Encoding
encode BranchRef
branchRef Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set Hash32 -> Encoding
forall a. Serialise a => a -> Encoding
encode Set Hash32
knownHashes
  decode :: forall s. Decoder s DownloadEntitiesRequest
decode = HashJWT -> BranchRef -> Set Hash32 -> DownloadEntitiesRequest
DownloadEntitiesRequest (HashJWT -> BranchRef -> Set Hash32 -> DownloadEntitiesRequest)
-> Decoder s HashJWT
-> Decoder s (BranchRef -> Set Hash32 -> DownloadEntitiesRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s HashJWT
forall s. Decoder s HashJWT
forall a s. Serialise a => Decoder s a
decode Decoder s (BranchRef -> Set Hash32 -> DownloadEntitiesRequest)
-> Decoder s BranchRef
-> Decoder s (Set Hash32 -> DownloadEntitiesRequest)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s BranchRef
forall s. Decoder s BranchRef
forall a s. Serialise a => Decoder s a
decode Decoder s (Set Hash32 -> DownloadEntitiesRequest)
-> Decoder s (Set Hash32) -> Decoder s DownloadEntitiesRequest
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Set Hash32)
forall s. Decoder s (Set Hash32)
forall a s. Serialise a => Decoder s a
decode

instance FromJSON DownloadEntitiesRequest where
  parseJSON :: Value -> Parser DownloadEntitiesRequest
parseJSON = String
-> (Object -> Parser DownloadEntitiesRequest)
-> Value
-> Parser DownloadEntitiesRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DownloadEntitiesRequest" ((Object -> Parser DownloadEntitiesRequest)
 -> Value -> Parser DownloadEntitiesRequest)
-> (Object -> Parser DownloadEntitiesRequest)
-> Value
-> Parser DownloadEntitiesRequest
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    HashJWT
causalHash <- Object
o Object -> Key -> Parser HashJWT
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"causalHash"
    BranchRef
branchRef <- Object
o Object -> Key -> Parser BranchRef
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"branchRef"
    Set Hash32
knownHashes <- Object
o Object -> Key -> Parser (Set Hash32)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"knownHashes"
    DownloadEntitiesRequest -> Parser DownloadEntitiesRequest
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DownloadEntitiesRequest {HashJWT
$sel:causalHash:DownloadEntitiesRequest :: HashJWT
causalHash :: HashJWT
causalHash, BranchRef
$sel:branchRef:DownloadEntitiesRequest :: BranchRef
branchRef :: BranchRef
branchRef, Set Hash32
$sel:knownHashes:DownloadEntitiesRequest :: Set Hash32
knownHashes :: Set Hash32
knownHashes}

instance ToJSON DownloadEntitiesRequest where
  toJSON :: DownloadEntitiesRequest -> Value
toJSON (DownloadEntitiesRequest {HashJWT
$sel:causalHash:DownloadEntitiesRequest :: DownloadEntitiesRequest -> HashJWT
causalHash :: HashJWT
causalHash, BranchRef
$sel:branchRef:DownloadEntitiesRequest :: DownloadEntitiesRequest -> BranchRef
branchRef :: BranchRef
branchRef, Set Hash32
$sel:knownHashes:DownloadEntitiesRequest :: DownloadEntitiesRequest -> Set Hash32
knownHashes :: Set Hash32
knownHashes}) =
    [Pair] -> Value
object
      [ Key
"causalHash" Key -> HashJWT -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= HashJWT
causalHash,
        Key
"branchRef" Key -> BranchRef -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BranchRef
branchRef,
        Key
"knownHashes" Key -> Set Hash32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Set Hash32
knownHashes
      ]

data DownloadEntitiesError
  = DownloadEntitiesNoReadPermission BranchRef
  | -- | msg, branchRef
    DownloadEntitiesInvalidBranchRef Text BranchRef
  | -- | userHandle
    DownloadEntitiesUserNotFound Text
  | -- | project shorthand
    DownloadEntitiesProjectNotFound Text
  | DownloadEntitiesEntityValidationFailure SyncV1.EntityValidationError
  deriving stock (DownloadEntitiesError -> DownloadEntitiesError -> Bool
(DownloadEntitiesError -> DownloadEntitiesError -> Bool)
-> (DownloadEntitiesError -> DownloadEntitiesError -> Bool)
-> Eq DownloadEntitiesError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DownloadEntitiesError -> DownloadEntitiesError -> Bool
== :: DownloadEntitiesError -> DownloadEntitiesError -> Bool
$c/= :: DownloadEntitiesError -> DownloadEntitiesError -> Bool
/= :: DownloadEntitiesError -> DownloadEntitiesError -> Bool
Eq, Int -> DownloadEntitiesError -> ShowS
[DownloadEntitiesError] -> ShowS
DownloadEntitiesError -> String
(Int -> DownloadEntitiesError -> ShowS)
-> (DownloadEntitiesError -> String)
-> ([DownloadEntitiesError] -> ShowS)
-> Show DownloadEntitiesError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DownloadEntitiesError -> ShowS
showsPrec :: Int -> DownloadEntitiesError -> ShowS
$cshow :: DownloadEntitiesError -> String
show :: DownloadEntitiesError -> String
$cshowList :: [DownloadEntitiesError] -> ShowS
showList :: [DownloadEntitiesError] -> ShowS
Show, Eq DownloadEntitiesError
Eq DownloadEntitiesError =>
(DownloadEntitiesError -> DownloadEntitiesError -> Ordering)
-> (DownloadEntitiesError -> DownloadEntitiesError -> Bool)
-> (DownloadEntitiesError -> DownloadEntitiesError -> Bool)
-> (DownloadEntitiesError -> DownloadEntitiesError -> Bool)
-> (DownloadEntitiesError -> DownloadEntitiesError -> Bool)
-> (DownloadEntitiesError
    -> DownloadEntitiesError -> DownloadEntitiesError)
-> (DownloadEntitiesError
    -> DownloadEntitiesError -> DownloadEntitiesError)
-> Ord DownloadEntitiesError
DownloadEntitiesError -> DownloadEntitiesError -> Bool
DownloadEntitiesError -> DownloadEntitiesError -> Ordering
DownloadEntitiesError
-> DownloadEntitiesError -> DownloadEntitiesError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DownloadEntitiesError -> DownloadEntitiesError -> Ordering
compare :: DownloadEntitiesError -> DownloadEntitiesError -> Ordering
$c< :: DownloadEntitiesError -> DownloadEntitiesError -> Bool
< :: DownloadEntitiesError -> DownloadEntitiesError -> Bool
$c<= :: DownloadEntitiesError -> DownloadEntitiesError -> Bool
<= :: DownloadEntitiesError -> DownloadEntitiesError -> Bool
$c> :: DownloadEntitiesError -> DownloadEntitiesError -> Bool
> :: DownloadEntitiesError -> DownloadEntitiesError -> Bool
$c>= :: DownloadEntitiesError -> DownloadEntitiesError -> Bool
>= :: DownloadEntitiesError -> DownloadEntitiesError -> Bool
$cmax :: DownloadEntitiesError
-> DownloadEntitiesError -> DownloadEntitiesError
max :: DownloadEntitiesError
-> DownloadEntitiesError -> DownloadEntitiesError
$cmin :: DownloadEntitiesError
-> DownloadEntitiesError -> DownloadEntitiesError
min :: DownloadEntitiesError
-> DownloadEntitiesError -> DownloadEntitiesError
Ord)

data DownloadEntitiesErrorTag
  = NoReadPermissionTag
  | InvalidBranchRefTag
  | UserNotFoundTag
  | ProjectNotFoundTag
  | EntityValidationFailureTag
  deriving stock (DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Bool
(DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Bool)
-> (DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Bool)
-> Eq DownloadEntitiesErrorTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Bool
== :: DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Bool
$c/= :: DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Bool
/= :: DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Bool
Eq, Int -> DownloadEntitiesErrorTag -> ShowS
[DownloadEntitiesErrorTag] -> ShowS
DownloadEntitiesErrorTag -> String
(Int -> DownloadEntitiesErrorTag -> ShowS)
-> (DownloadEntitiesErrorTag -> String)
-> ([DownloadEntitiesErrorTag] -> ShowS)
-> Show DownloadEntitiesErrorTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DownloadEntitiesErrorTag -> ShowS
showsPrec :: Int -> DownloadEntitiesErrorTag -> ShowS
$cshow :: DownloadEntitiesErrorTag -> String
show :: DownloadEntitiesErrorTag -> String
$cshowList :: [DownloadEntitiesErrorTag] -> ShowS
showList :: [DownloadEntitiesErrorTag] -> ShowS
Show, Eq DownloadEntitiesErrorTag
Eq DownloadEntitiesErrorTag =>
(DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Ordering)
-> (DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Bool)
-> (DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Bool)
-> (DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Bool)
-> (DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Bool)
-> (DownloadEntitiesErrorTag
    -> DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag)
-> (DownloadEntitiesErrorTag
    -> DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag)
-> Ord DownloadEntitiesErrorTag
DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Bool
DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Ordering
DownloadEntitiesErrorTag
-> DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Ordering
compare :: DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Ordering
$c< :: DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Bool
< :: DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Bool
$c<= :: DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Bool
<= :: DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Bool
$c> :: DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Bool
> :: DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Bool
$c>= :: DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Bool
>= :: DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag -> Bool
$cmax :: DownloadEntitiesErrorTag
-> DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag
max :: DownloadEntitiesErrorTag
-> DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag
$cmin :: DownloadEntitiesErrorTag
-> DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag
min :: DownloadEntitiesErrorTag
-> DownloadEntitiesErrorTag -> DownloadEntitiesErrorTag
Ord)

instance Serialise DownloadEntitiesErrorTag where
  encode :: DownloadEntitiesErrorTag -> Encoding
encode = \case
    DownloadEntitiesErrorTag
NoReadPermissionTag -> Word8 -> Encoding
CBOR.encodeWord8 Word8
0
    DownloadEntitiesErrorTag
InvalidBranchRefTag -> Word8 -> Encoding
CBOR.encodeWord8 Word8
1
    DownloadEntitiesErrorTag
UserNotFoundTag -> Word8 -> Encoding
CBOR.encodeWord8 Word8
2
    DownloadEntitiesErrorTag
ProjectNotFoundTag -> Word8 -> Encoding
CBOR.encodeWord8 Word8
3
    DownloadEntitiesErrorTag
EntityValidationFailureTag -> Word8 -> Encoding
CBOR.encodeWord8 Word8
4
  decode :: forall s. Decoder s DownloadEntitiesErrorTag
decode = do
    Word8
tag <- Decoder s Word8
forall s. Decoder s Word8
CBOR.decodeWord8
    case Word8
tag of
      Word8
0 -> DownloadEntitiesErrorTag -> Decoder s DownloadEntitiesErrorTag
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DownloadEntitiesErrorTag
NoReadPermissionTag
      Word8
1 -> DownloadEntitiesErrorTag -> Decoder s DownloadEntitiesErrorTag
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DownloadEntitiesErrorTag
InvalidBranchRefTag
      Word8
2 -> DownloadEntitiesErrorTag -> Decoder s DownloadEntitiesErrorTag
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DownloadEntitiesErrorTag
UserNotFoundTag
      Word8
3 -> DownloadEntitiesErrorTag -> Decoder s DownloadEntitiesErrorTag
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DownloadEntitiesErrorTag
ProjectNotFoundTag
      Word8
4 -> DownloadEntitiesErrorTag -> Decoder s DownloadEntitiesErrorTag
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DownloadEntitiesErrorTag
EntityValidationFailureTag
      Word8
_ -> String -> Decoder s DownloadEntitiesErrorTag
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid tag"

instance Serialise DownloadEntitiesError where
  encode :: DownloadEntitiesError -> Encoding
encode = \case
    DownloadEntitiesNoReadPermission BranchRef
branchRef -> DownloadEntitiesErrorTag -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode DownloadEntitiesErrorTag
NoReadPermissionTag Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> BranchRef -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode BranchRef
branchRef
    DownloadEntitiesInvalidBranchRef Text
msg BranchRef
branchRef -> DownloadEntitiesErrorTag -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode DownloadEntitiesErrorTag
InvalidBranchRefTag Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Text, BranchRef) -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode (Text
msg, BranchRef
branchRef)
    DownloadEntitiesUserNotFound Text
userHandle -> DownloadEntitiesErrorTag -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode DownloadEntitiesErrorTag
UserNotFoundTag Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode Text
userHandle
    DownloadEntitiesProjectNotFound Text
projectShorthand -> DownloadEntitiesErrorTag -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode DownloadEntitiesErrorTag
ProjectNotFoundTag Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode Text
projectShorthand
    DownloadEntitiesEntityValidationFailure EntityValidationError
err -> DownloadEntitiesErrorTag -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode DownloadEntitiesErrorTag
EntityValidationFailureTag Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> EntityValidationError -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode EntityValidationError
err

  decode :: forall s. Decoder s DownloadEntitiesError
decode = do
    DownloadEntitiesErrorTag
tag <- Decoder s DownloadEntitiesErrorTag
forall s. Decoder s DownloadEntitiesErrorTag
forall a s. Serialise a => Decoder s a
CBOR.decode
    case DownloadEntitiesErrorTag
tag of
      DownloadEntitiesErrorTag
NoReadPermissionTag -> BranchRef -> DownloadEntitiesError
DownloadEntitiesNoReadPermission (BranchRef -> DownloadEntitiesError)
-> Decoder s BranchRef -> Decoder s DownloadEntitiesError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s BranchRef
forall s. Decoder s BranchRef
forall a s. Serialise a => Decoder s a
CBOR.decode
      DownloadEntitiesErrorTag
InvalidBranchRefTag -> (Text -> BranchRef -> DownloadEntitiesError)
-> (Text, BranchRef) -> DownloadEntitiesError
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> BranchRef -> DownloadEntitiesError
DownloadEntitiesInvalidBranchRef ((Text, BranchRef) -> DownloadEntitiesError)
-> Decoder s (Text, BranchRef) -> Decoder s DownloadEntitiesError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Text, BranchRef)
forall s. Decoder s (Text, BranchRef)
forall a s. Serialise a => Decoder s a
CBOR.decode
      DownloadEntitiesErrorTag
UserNotFoundTag -> Text -> DownloadEntitiesError
DownloadEntitiesUserNotFound (Text -> DownloadEntitiesError)
-> Decoder s Text -> Decoder s DownloadEntitiesError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Text
forall s. Decoder s Text
forall a s. Serialise a => Decoder s a
CBOR.decode
      DownloadEntitiesErrorTag
ProjectNotFoundTag -> Text -> DownloadEntitiesError
DownloadEntitiesProjectNotFound (Text -> DownloadEntitiesError)
-> Decoder s Text -> Decoder s DownloadEntitiesError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Text
forall s. Decoder s Text
forall a s. Serialise a => Decoder s a
CBOR.decode
      DownloadEntitiesErrorTag
EntityValidationFailureTag -> EntityValidationError -> DownloadEntitiesError
DownloadEntitiesEntityValidationFailure (EntityValidationError -> DownloadEntitiesError)
-> Decoder s EntityValidationError
-> Decoder s DownloadEntitiesError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s EntityValidationError
forall s. Decoder s EntityValidationError
forall a s. Serialise a => Decoder s a
CBOR.decode

data EntitySorting
  = -- all dependencies of an entity are guaranteed to be sent before the entity itself
    DependenciesFirst
  | -- no guarantees.
    Unsorted
  deriving (Int -> EntitySorting -> ShowS
[EntitySorting] -> ShowS
EntitySorting -> String
(Int -> EntitySorting -> ShowS)
-> (EntitySorting -> String)
-> ([EntitySorting] -> ShowS)
-> Show EntitySorting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntitySorting -> ShowS
showsPrec :: Int -> EntitySorting -> ShowS
$cshow :: EntitySorting -> String
show :: EntitySorting -> String
$cshowList :: [EntitySorting] -> ShowS
showList :: [EntitySorting] -> ShowS
Show, EntitySorting -> EntitySorting -> Bool
(EntitySorting -> EntitySorting -> Bool)
-> (EntitySorting -> EntitySorting -> Bool) -> Eq EntitySorting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EntitySorting -> EntitySorting -> Bool
== :: EntitySorting -> EntitySorting -> Bool
$c/= :: EntitySorting -> EntitySorting -> Bool
/= :: EntitySorting -> EntitySorting -> Bool
Eq, Eq EntitySorting
Eq EntitySorting =>
(EntitySorting -> EntitySorting -> Ordering)
-> (EntitySorting -> EntitySorting -> Bool)
-> (EntitySorting -> EntitySorting -> Bool)
-> (EntitySorting -> EntitySorting -> Bool)
-> (EntitySorting -> EntitySorting -> Bool)
-> (EntitySorting -> EntitySorting -> EntitySorting)
-> (EntitySorting -> EntitySorting -> EntitySorting)
-> Ord EntitySorting
EntitySorting -> EntitySorting -> Bool
EntitySorting -> EntitySorting -> Ordering
EntitySorting -> EntitySorting -> EntitySorting
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EntitySorting -> EntitySorting -> Ordering
compare :: EntitySorting -> EntitySorting -> Ordering
$c< :: EntitySorting -> EntitySorting -> Bool
< :: EntitySorting -> EntitySorting -> Bool
$c<= :: EntitySorting -> EntitySorting -> Bool
<= :: EntitySorting -> EntitySorting -> Bool
$c> :: EntitySorting -> EntitySorting -> Bool
> :: EntitySorting -> EntitySorting -> Bool
$c>= :: EntitySorting -> EntitySorting -> Bool
>= :: EntitySorting -> EntitySorting -> Bool
$cmax :: EntitySorting -> EntitySorting -> EntitySorting
max :: EntitySorting -> EntitySorting -> EntitySorting
$cmin :: EntitySorting -> EntitySorting -> EntitySorting
min :: EntitySorting -> EntitySorting -> EntitySorting
Ord)

instance Serialise EntitySorting where
  encode :: EntitySorting -> Encoding
encode = \case
    EntitySorting
DependenciesFirst -> Word8 -> Encoding
CBOR.encodeWord8 Word8
0
    EntitySorting
Unsorted -> Word8 -> Encoding
CBOR.encodeWord8 Word8
1
  decode :: forall s. Decoder s EntitySorting
decode = do
    Word8
tag <- Decoder s Word8
forall s. Decoder s Word8
CBOR.decodeWord8
    case Word8
tag of
      Word8
0 -> EntitySorting -> Decoder s EntitySorting
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EntitySorting
DependenciesFirst
      Word8
1 -> EntitySorting -> Decoder s EntitySorting
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EntitySorting
Unsorted
      Word8
_ -> String -> Decoder s EntitySorting
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid tag"

newtype Version = Version Word16
  deriving stock (Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Version -> ShowS
showsPrec :: Int -> Version -> ShowS
$cshow :: Version -> String
show :: Version -> String
$cshowList :: [Version] -> ShowS
showList :: [Version] -> ShowS
Show)
  deriving newtype (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
/= :: Version -> Version -> Bool
Eq, Eq Version
Eq Version =>
(Version -> Version -> Ordering)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Version)
-> (Version -> Version -> Version)
-> Ord Version
Version -> Version -> Bool
Version -> Version -> Ordering
Version -> Version -> Version
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Version -> Version -> Ordering
compare :: Version -> Version -> Ordering
$c< :: Version -> Version -> Bool
< :: Version -> Version -> Bool
$c<= :: Version -> Version -> Bool
<= :: Version -> Version -> Bool
$c> :: Version -> Version -> Bool
> :: Version -> Version -> Bool
$c>= :: Version -> Version -> Bool
>= :: Version -> Version -> Bool
$cmax :: Version -> Version -> Version
max :: Version -> Version -> Version
$cmin :: Version -> Version -> Version
min :: Version -> Version -> Version
Ord, [Version] -> Encoding
Version -> Encoding
(Version -> Encoding)
-> (forall s. Decoder s Version)
-> ([Version] -> Encoding)
-> (forall s. Decoder s [Version])
-> Serialise Version
forall s. Decoder s [Version]
forall s. Decoder s Version
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: Version -> Encoding
encode :: Version -> Encoding
$cdecode :: forall s. Decoder s Version
decode :: forall s. Decoder s Version
$cencodeList :: [Version] -> Encoding
encodeList :: [Version] -> Encoding
$cdecodeList :: forall s. Decoder s [Version]
decodeList :: forall s. Decoder s [Version]
Serialise)

data StreamInitInfo = StreamInitInfo
  { StreamInitInfo -> Version
version :: Version,
    StreamInitInfo -> EntitySorting
entitySorting :: EntitySorting,
    StreamInitInfo -> Maybe Word64
numEntities :: Maybe Word64,
    StreamInitInfo -> Hash32
rootCausalHash :: Hash32,
    StreamInitInfo -> Maybe BranchRef
rootBranchRef :: Maybe BranchRef
  }
  deriving (Int -> StreamInitInfo -> ShowS
[StreamInitInfo] -> ShowS
StreamInitInfo -> String
(Int -> StreamInitInfo -> ShowS)
-> (StreamInitInfo -> String)
-> ([StreamInitInfo] -> ShowS)
-> Show StreamInitInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StreamInitInfo -> ShowS
showsPrec :: Int -> StreamInitInfo -> ShowS
$cshow :: StreamInitInfo -> String
show :: StreamInitInfo -> String
$cshowList :: [StreamInitInfo] -> ShowS
showList :: [StreamInitInfo] -> ShowS
Show, StreamInitInfo -> StreamInitInfo -> Bool
(StreamInitInfo -> StreamInitInfo -> Bool)
-> (StreamInitInfo -> StreamInitInfo -> Bool) -> Eq StreamInitInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StreamInitInfo -> StreamInitInfo -> Bool
== :: StreamInitInfo -> StreamInitInfo -> Bool
$c/= :: StreamInitInfo -> StreamInitInfo -> Bool
/= :: StreamInitInfo -> StreamInitInfo -> Bool
Eq, Eq StreamInitInfo
Eq StreamInitInfo =>
(StreamInitInfo -> StreamInitInfo -> Ordering)
-> (StreamInitInfo -> StreamInitInfo -> Bool)
-> (StreamInitInfo -> StreamInitInfo -> Bool)
-> (StreamInitInfo -> StreamInitInfo -> Bool)
-> (StreamInitInfo -> StreamInitInfo -> Bool)
-> (StreamInitInfo -> StreamInitInfo -> StreamInitInfo)
-> (StreamInitInfo -> StreamInitInfo -> StreamInitInfo)
-> Ord StreamInitInfo
StreamInitInfo -> StreamInitInfo -> Bool
StreamInitInfo -> StreamInitInfo -> Ordering
StreamInitInfo -> StreamInitInfo -> StreamInitInfo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StreamInitInfo -> StreamInitInfo -> Ordering
compare :: StreamInitInfo -> StreamInitInfo -> Ordering
$c< :: StreamInitInfo -> StreamInitInfo -> Bool
< :: StreamInitInfo -> StreamInitInfo -> Bool
$c<= :: StreamInitInfo -> StreamInitInfo -> Bool
<= :: StreamInitInfo -> StreamInitInfo -> Bool
$c> :: StreamInitInfo -> StreamInitInfo -> Bool
> :: StreamInitInfo -> StreamInitInfo -> Bool
$c>= :: StreamInitInfo -> StreamInitInfo -> Bool
>= :: StreamInitInfo -> StreamInitInfo -> Bool
$cmax :: StreamInitInfo -> StreamInitInfo -> StreamInitInfo
max :: StreamInitInfo -> StreamInitInfo -> StreamInitInfo
$cmin :: StreamInitInfo -> StreamInitInfo -> StreamInitInfo
min :: StreamInitInfo -> StreamInitInfo -> StreamInitInfo
Ord)

decodeMapKey :: (Serialise r) => Text -> Map Text UnknownCBORBytes -> CBOR.Decoder s r
decodeMapKey :: forall r s.
Serialise r =>
Text -> Map Text UnknownCBORBytes -> Decoder s r
decodeMapKey Text
k Map Text UnknownCBORBytes
m =
  Text -> Map Text UnknownCBORBytes -> Decoder s (Maybe r)
forall r s.
Serialise r =>
Text -> Map Text UnknownCBORBytes -> Decoder s (Maybe r)
optionalDecodeMapKey Text
k Map Text UnknownCBORBytes
m Decoder s (Maybe r) -> (Maybe r -> Decoder s r) -> Decoder s r
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe r
Nothing -> String -> Decoder s r
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s r) -> String -> Decoder s r
forall a b. (a -> b) -> a -> b
$ String
"Expected key: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
k
    Just r
x -> r -> Decoder s r
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
x

optionalDecodeMapKey :: (Serialise r) => Text -> Map Text UnknownCBORBytes -> CBOR.Decoder s (Maybe r)
optionalDecodeMapKey :: forall r s.
Serialise r =>
Text -> Map Text UnknownCBORBytes -> Decoder s (Maybe r)
optionalDecodeMapKey Text
k Map Text UnknownCBORBytes
m =
  case Text -> Map Text UnknownCBORBytes -> Maybe UnknownCBORBytes
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
k Map Text UnknownCBORBytes
m of
    Maybe UnknownCBORBytes
Nothing -> Maybe r -> Decoder s (Maybe r)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe r
forall a. Maybe a
Nothing
    Just UnknownCBORBytes
bs -> r -> Maybe r
forall a. a -> Maybe a
Just (r -> Maybe r) -> Decoder s r -> Decoder s (Maybe r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnknownCBORBytes -> Decoder s r
forall t s. Serialise t => UnknownCBORBytes -> Decoder s t
decodeUnknownCBORBytes UnknownCBORBytes
bs

-- | Serialised as a map to be future compatible, allowing for future expansion.
instance Serialise StreamInitInfo where
  encode :: StreamInitInfo -> Encoding
encode (StreamInitInfo {Version
$sel:version:StreamInitInfo :: StreamInitInfo -> Version
version :: Version
version, EntitySorting
$sel:entitySorting:StreamInitInfo :: StreamInitInfo -> EntitySorting
entitySorting :: EntitySorting
entitySorting, Maybe Word64
$sel:numEntities:StreamInitInfo :: StreamInitInfo -> Maybe Word64
numEntities :: Maybe Word64
numEntities, Hash32
$sel:rootCausalHash:StreamInitInfo :: StreamInitInfo -> Hash32
rootCausalHash :: Hash32
rootCausalHash, Maybe BranchRef
$sel:rootBranchRef:StreamInitInfo :: StreamInitInfo -> Maybe BranchRef
rootBranchRef :: Maybe BranchRef
rootBranchRef}) =
    Map Text UnknownCBORBytes -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode
      ( [(Text, UnknownCBORBytes)] -> Map Text UnknownCBORBytes
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, UnknownCBORBytes)] -> Map Text UnknownCBORBytes)
-> [(Text, UnknownCBORBytes)] -> Map Text UnknownCBORBytes
forall a b. (a -> b) -> a -> b
$
          [ (Text
"v" :: Text, Version -> UnknownCBORBytes
forall t. Serialise t => t -> UnknownCBORBytes
serialiseUnknownCBORBytes Version
version),
            (Text
"es", EntitySorting -> UnknownCBORBytes
forall t. Serialise t => t -> UnknownCBORBytes
serialiseUnknownCBORBytes EntitySorting
entitySorting),
            (Text
"rc", Hash32 -> UnknownCBORBytes
forall t. Serialise t => t -> UnknownCBORBytes
serialiseUnknownCBORBytes Hash32
rootCausalHash)
          ]
            [(Text, UnknownCBORBytes)]
-> [(Text, UnknownCBORBytes)] -> [(Text, UnknownCBORBytes)]
forall a. Semigroup a => a -> a -> a
<> [(Text, UnknownCBORBytes)]
-> (Word64 -> [(Text, UnknownCBORBytes)])
-> Maybe Word64
-> [(Text, UnknownCBORBytes)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Word64
ne -> [(Text
"ne", Word64 -> UnknownCBORBytes
forall t. Serialise t => t -> UnknownCBORBytes
serialiseUnknownCBORBytes Word64
ne)]) Maybe Word64
numEntities
            [(Text, UnknownCBORBytes)]
-> [(Text, UnknownCBORBytes)] -> [(Text, UnknownCBORBytes)]
forall a. Semigroup a => a -> a -> a
<> [(Text, UnknownCBORBytes)]
-> (BranchRef -> [(Text, UnknownCBORBytes)])
-> Maybe BranchRef
-> [(Text, UnknownCBORBytes)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\BranchRef
br -> [(Text
"br", BranchRef -> UnknownCBORBytes
forall t. Serialise t => t -> UnknownCBORBytes
serialiseUnknownCBORBytes BranchRef
br)]) Maybe BranchRef
rootBranchRef
      )
  decode :: forall s. Decoder s StreamInitInfo
decode = do
    Map Text UnknownCBORBytes
m <- Decoder s (Map Text UnknownCBORBytes)
forall s. Decoder s (Map Text UnknownCBORBytes)
forall a s. Serialise a => Decoder s a
CBOR.decode
    Version
version <- Text -> Map Text UnknownCBORBytes -> Decoder s Version
forall r s.
Serialise r =>
Text -> Map Text UnknownCBORBytes -> Decoder s r
decodeMapKey Text
"v" Map Text UnknownCBORBytes
m
    EntitySorting
entitySorting <- Text -> Map Text UnknownCBORBytes -> Decoder s EntitySorting
forall r s.
Serialise r =>
Text -> Map Text UnknownCBORBytes -> Decoder s r
decodeMapKey Text
"es" Map Text UnknownCBORBytes
m
    Maybe Word64
numEntities <- (Text -> Map Text UnknownCBORBytes -> Decoder s (Maybe Word64)
forall r s.
Serialise r =>
Text -> Map Text UnknownCBORBytes -> Decoder s (Maybe r)
optionalDecodeMapKey Text
"ne" Map Text UnknownCBORBytes
m)
    Hash32
rootCausalHash <- Text -> Map Text UnknownCBORBytes -> Decoder s Hash32
forall r s.
Serialise r =>
Text -> Map Text UnknownCBORBytes -> Decoder s r
decodeMapKey Text
"rc" Map Text UnknownCBORBytes
m
    Maybe BranchRef
rootBranchRef <- Text -> Map Text UnknownCBORBytes -> Decoder s (Maybe BranchRef)
forall r s.
Serialise r =>
Text -> Map Text UnknownCBORBytes -> Decoder s (Maybe r)
optionalDecodeMapKey Text
"br" Map Text UnknownCBORBytes
m
    StreamInitInfo -> Decoder s StreamInitInfo
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StreamInitInfo {Version
$sel:version:StreamInitInfo :: Version
version :: Version
version, EntitySorting
$sel:entitySorting:StreamInitInfo :: EntitySorting
entitySorting :: EntitySorting
entitySorting, Maybe Word64
$sel:numEntities:StreamInitInfo :: Maybe Word64
numEntities :: Maybe Word64
numEntities, Hash32
$sel:rootCausalHash:StreamInitInfo :: Hash32
rootCausalHash :: Hash32
rootCausalHash, Maybe BranchRef
$sel:rootBranchRef:StreamInitInfo :: Maybe BranchRef
rootBranchRef :: Maybe BranchRef
rootBranchRef}

data EntityChunk = EntityChunk
  { EntityChunk -> Hash32
hash :: Hash32,
    EntityChunk -> CBORBytes TempEntity
entityCBOR :: CBORBytes TempEntity
  }
  deriving (Int -> EntityChunk -> ShowS
[EntityChunk] -> ShowS
EntityChunk -> String
(Int -> EntityChunk -> ShowS)
-> (EntityChunk -> String)
-> ([EntityChunk] -> ShowS)
-> Show EntityChunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntityChunk -> ShowS
showsPrec :: Int -> EntityChunk -> ShowS
$cshow :: EntityChunk -> String
show :: EntityChunk -> String
$cshowList :: [EntityChunk] -> ShowS
showList :: [EntityChunk] -> ShowS
Show, EntityChunk -> EntityChunk -> Bool
(EntityChunk -> EntityChunk -> Bool)
-> (EntityChunk -> EntityChunk -> Bool) -> Eq EntityChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EntityChunk -> EntityChunk -> Bool
== :: EntityChunk -> EntityChunk -> Bool
$c/= :: EntityChunk -> EntityChunk -> Bool
/= :: EntityChunk -> EntityChunk -> Bool
Eq, Eq EntityChunk
Eq EntityChunk =>
(EntityChunk -> EntityChunk -> Ordering)
-> (EntityChunk -> EntityChunk -> Bool)
-> (EntityChunk -> EntityChunk -> Bool)
-> (EntityChunk -> EntityChunk -> Bool)
-> (EntityChunk -> EntityChunk -> Bool)
-> (EntityChunk -> EntityChunk -> EntityChunk)
-> (EntityChunk -> EntityChunk -> EntityChunk)
-> Ord EntityChunk
EntityChunk -> EntityChunk -> Bool
EntityChunk -> EntityChunk -> Ordering
EntityChunk -> EntityChunk -> EntityChunk
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EntityChunk -> EntityChunk -> Ordering
compare :: EntityChunk -> EntityChunk -> Ordering
$c< :: EntityChunk -> EntityChunk -> Bool
< :: EntityChunk -> EntityChunk -> Bool
$c<= :: EntityChunk -> EntityChunk -> Bool
<= :: EntityChunk -> EntityChunk -> Bool
$c> :: EntityChunk -> EntityChunk -> Bool
> :: EntityChunk -> EntityChunk -> Bool
$c>= :: EntityChunk -> EntityChunk -> Bool
>= :: EntityChunk -> EntityChunk -> Bool
$cmax :: EntityChunk -> EntityChunk -> EntityChunk
max :: EntityChunk -> EntityChunk -> EntityChunk
$cmin :: EntityChunk -> EntityChunk -> EntityChunk
min :: EntityChunk -> EntityChunk -> EntityChunk
Ord)

instance Serialise EntityChunk where
  encode :: EntityChunk -> Encoding
encode (EntityChunk {Hash32
$sel:hash:EntityChunk :: EntityChunk -> Hash32
hash :: Hash32
hash, CBORBytes TempEntity
$sel:entityCBOR:EntityChunk :: EntityChunk -> CBORBytes TempEntity
entityCBOR :: CBORBytes TempEntity
entityCBOR}) = Hash32 -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode Hash32
hash Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CBORBytes TempEntity -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode CBORBytes TempEntity
entityCBOR
  decode :: forall s. Decoder s EntityChunk
decode = Hash32 -> CBORBytes TempEntity -> EntityChunk
EntityChunk (Hash32 -> CBORBytes TempEntity -> EntityChunk)
-> Decoder s Hash32
-> Decoder s (CBORBytes TempEntity -> EntityChunk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Hash32
forall s. Decoder s Hash32
forall a s. Serialise a => Decoder s a
CBOR.decode Decoder s (CBORBytes TempEntity -> EntityChunk)
-> Decoder s (CBORBytes TempEntity) -> Decoder s EntityChunk
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (CBORBytes TempEntity)
forall s. Decoder s (CBORBytes TempEntity)
forall a s. Serialise a => Decoder s a
CBOR.decode

data ErrorChunk = ErrorChunk
  { ErrorChunk -> DownloadEntitiesError
err :: DownloadEntitiesError
  }
  deriving (Int -> ErrorChunk -> ShowS
[ErrorChunk] -> ShowS
ErrorChunk -> String
(Int -> ErrorChunk -> ShowS)
-> (ErrorChunk -> String)
-> ([ErrorChunk] -> ShowS)
-> Show ErrorChunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrorChunk -> ShowS
showsPrec :: Int -> ErrorChunk -> ShowS
$cshow :: ErrorChunk -> String
show :: ErrorChunk -> String
$cshowList :: [ErrorChunk] -> ShowS
showList :: [ErrorChunk] -> ShowS
Show, ErrorChunk -> ErrorChunk -> Bool
(ErrorChunk -> ErrorChunk -> Bool)
-> (ErrorChunk -> ErrorChunk -> Bool) -> Eq ErrorChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ErrorChunk -> ErrorChunk -> Bool
== :: ErrorChunk -> ErrorChunk -> Bool
$c/= :: ErrorChunk -> ErrorChunk -> Bool
/= :: ErrorChunk -> ErrorChunk -> Bool
Eq, Eq ErrorChunk
Eq ErrorChunk =>
(ErrorChunk -> ErrorChunk -> Ordering)
-> (ErrorChunk -> ErrorChunk -> Bool)
-> (ErrorChunk -> ErrorChunk -> Bool)
-> (ErrorChunk -> ErrorChunk -> Bool)
-> (ErrorChunk -> ErrorChunk -> Bool)
-> (ErrorChunk -> ErrorChunk -> ErrorChunk)
-> (ErrorChunk -> ErrorChunk -> ErrorChunk)
-> Ord ErrorChunk
ErrorChunk -> ErrorChunk -> Bool
ErrorChunk -> ErrorChunk -> Ordering
ErrorChunk -> ErrorChunk -> ErrorChunk
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ErrorChunk -> ErrorChunk -> Ordering
compare :: ErrorChunk -> ErrorChunk -> Ordering
$c< :: ErrorChunk -> ErrorChunk -> Bool
< :: ErrorChunk -> ErrorChunk -> Bool
$c<= :: ErrorChunk -> ErrorChunk -> Bool
<= :: ErrorChunk -> ErrorChunk -> Bool
$c> :: ErrorChunk -> ErrorChunk -> Bool
> :: ErrorChunk -> ErrorChunk -> Bool
$c>= :: ErrorChunk -> ErrorChunk -> Bool
>= :: ErrorChunk -> ErrorChunk -> Bool
$cmax :: ErrorChunk -> ErrorChunk -> ErrorChunk
max :: ErrorChunk -> ErrorChunk -> ErrorChunk
$cmin :: ErrorChunk -> ErrorChunk -> ErrorChunk
min :: ErrorChunk -> ErrorChunk -> ErrorChunk
Ord)

instance Serialise ErrorChunk where
  encode :: ErrorChunk -> Encoding
encode (ErrorChunk {DownloadEntitiesError
$sel:err:ErrorChunk :: ErrorChunk -> DownloadEntitiesError
err :: DownloadEntitiesError
err}) = DownloadEntitiesError -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode DownloadEntitiesError
err
  decode :: forall s. Decoder s ErrorChunk
decode = DownloadEntitiesError -> ErrorChunk
ErrorChunk (DownloadEntitiesError -> ErrorChunk)
-> Decoder s DownloadEntitiesError -> Decoder s ErrorChunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s DownloadEntitiesError
forall s. Decoder s DownloadEntitiesError
forall a s. Serialise a => Decoder s a
CBOR.decode

-- | A chunk of the download entities response stream.
data DownloadEntitiesChunk
  = InitialC StreamInitInfo
  | EntityC EntityChunk
  | ErrorC ErrorChunk
  deriving (Int -> DownloadEntitiesChunk -> ShowS
[DownloadEntitiesChunk] -> ShowS
DownloadEntitiesChunk -> String
(Int -> DownloadEntitiesChunk -> ShowS)
-> (DownloadEntitiesChunk -> String)
-> ([DownloadEntitiesChunk] -> ShowS)
-> Show DownloadEntitiesChunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DownloadEntitiesChunk -> ShowS
showsPrec :: Int -> DownloadEntitiesChunk -> ShowS
$cshow :: DownloadEntitiesChunk -> String
show :: DownloadEntitiesChunk -> String
$cshowList :: [DownloadEntitiesChunk] -> ShowS
showList :: [DownloadEntitiesChunk] -> ShowS
Show, DownloadEntitiesChunk -> DownloadEntitiesChunk -> Bool
(DownloadEntitiesChunk -> DownloadEntitiesChunk -> Bool)
-> (DownloadEntitiesChunk -> DownloadEntitiesChunk -> Bool)
-> Eq DownloadEntitiesChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DownloadEntitiesChunk -> DownloadEntitiesChunk -> Bool
== :: DownloadEntitiesChunk -> DownloadEntitiesChunk -> Bool
$c/= :: DownloadEntitiesChunk -> DownloadEntitiesChunk -> Bool
/= :: DownloadEntitiesChunk -> DownloadEntitiesChunk -> Bool
Eq, Eq DownloadEntitiesChunk
Eq DownloadEntitiesChunk =>
(DownloadEntitiesChunk -> DownloadEntitiesChunk -> Ordering)
-> (DownloadEntitiesChunk -> DownloadEntitiesChunk -> Bool)
-> (DownloadEntitiesChunk -> DownloadEntitiesChunk -> Bool)
-> (DownloadEntitiesChunk -> DownloadEntitiesChunk -> Bool)
-> (DownloadEntitiesChunk -> DownloadEntitiesChunk -> Bool)
-> (DownloadEntitiesChunk
    -> DownloadEntitiesChunk -> DownloadEntitiesChunk)
-> (DownloadEntitiesChunk
    -> DownloadEntitiesChunk -> DownloadEntitiesChunk)
-> Ord DownloadEntitiesChunk
DownloadEntitiesChunk -> DownloadEntitiesChunk -> Bool
DownloadEntitiesChunk -> DownloadEntitiesChunk -> Ordering
DownloadEntitiesChunk
-> DownloadEntitiesChunk -> DownloadEntitiesChunk
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DownloadEntitiesChunk -> DownloadEntitiesChunk -> Ordering
compare :: DownloadEntitiesChunk -> DownloadEntitiesChunk -> Ordering
$c< :: DownloadEntitiesChunk -> DownloadEntitiesChunk -> Bool
< :: DownloadEntitiesChunk -> DownloadEntitiesChunk -> Bool
$c<= :: DownloadEntitiesChunk -> DownloadEntitiesChunk -> Bool
<= :: DownloadEntitiesChunk -> DownloadEntitiesChunk -> Bool
$c> :: DownloadEntitiesChunk -> DownloadEntitiesChunk -> Bool
> :: DownloadEntitiesChunk -> DownloadEntitiesChunk -> Bool
$c>= :: DownloadEntitiesChunk -> DownloadEntitiesChunk -> Bool
>= :: DownloadEntitiesChunk -> DownloadEntitiesChunk -> Bool
$cmax :: DownloadEntitiesChunk
-> DownloadEntitiesChunk -> DownloadEntitiesChunk
max :: DownloadEntitiesChunk
-> DownloadEntitiesChunk -> DownloadEntitiesChunk
$cmin :: DownloadEntitiesChunk
-> DownloadEntitiesChunk -> DownloadEntitiesChunk
min :: DownloadEntitiesChunk
-> DownloadEntitiesChunk -> DownloadEntitiesChunk
Ord)

data DownloadEntitiesChunkTag = InitialChunkTag | EntityChunkTag | ErrorChunkTag
  deriving (Int -> DownloadEntitiesChunkTag -> ShowS
[DownloadEntitiesChunkTag] -> ShowS
DownloadEntitiesChunkTag -> String
(Int -> DownloadEntitiesChunkTag -> ShowS)
-> (DownloadEntitiesChunkTag -> String)
-> ([DownloadEntitiesChunkTag] -> ShowS)
-> Show DownloadEntitiesChunkTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DownloadEntitiesChunkTag -> ShowS
showsPrec :: Int -> DownloadEntitiesChunkTag -> ShowS
$cshow :: DownloadEntitiesChunkTag -> String
show :: DownloadEntitiesChunkTag -> String
$cshowList :: [DownloadEntitiesChunkTag] -> ShowS
showList :: [DownloadEntitiesChunkTag] -> ShowS
Show, DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Bool
(DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Bool)
-> (DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Bool)
-> Eq DownloadEntitiesChunkTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Bool
== :: DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Bool
$c/= :: DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Bool
/= :: DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Bool
Eq, Eq DownloadEntitiesChunkTag
Eq DownloadEntitiesChunkTag =>
(DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Ordering)
-> (DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Bool)
-> (DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Bool)
-> (DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Bool)
-> (DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Bool)
-> (DownloadEntitiesChunkTag
    -> DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag)
-> (DownloadEntitiesChunkTag
    -> DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag)
-> Ord DownloadEntitiesChunkTag
DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Bool
DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Ordering
DownloadEntitiesChunkTag
-> DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Ordering
compare :: DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Ordering
$c< :: DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Bool
< :: DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Bool
$c<= :: DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Bool
<= :: DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Bool
$c> :: DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Bool
> :: DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Bool
$c>= :: DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Bool
>= :: DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag -> Bool
$cmax :: DownloadEntitiesChunkTag
-> DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag
max :: DownloadEntitiesChunkTag
-> DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag
$cmin :: DownloadEntitiesChunkTag
-> DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag
min :: DownloadEntitiesChunkTag
-> DownloadEntitiesChunkTag -> DownloadEntitiesChunkTag
Ord)

instance Serialise DownloadEntitiesChunkTag where
  encode :: DownloadEntitiesChunkTag -> Encoding
encode DownloadEntitiesChunkTag
InitialChunkTag = Word8 -> Encoding
CBOR.encodeWord8 Word8
0
  encode DownloadEntitiesChunkTag
EntityChunkTag = Word8 -> Encoding
CBOR.encodeWord8 Word8
1
  encode DownloadEntitiesChunkTag
ErrorChunkTag = Word8 -> Encoding
CBOR.encodeWord8 Word8
2
  decode :: forall s. Decoder s DownloadEntitiesChunkTag
decode = do
    Word8
tag <- Decoder s Word8
forall s. Decoder s Word8
CBOR.decodeWord8
    case Word8
tag of
      Word8
0 -> DownloadEntitiesChunkTag -> Decoder s DownloadEntitiesChunkTag
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DownloadEntitiesChunkTag
InitialChunkTag
      Word8
1 -> DownloadEntitiesChunkTag -> Decoder s DownloadEntitiesChunkTag
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DownloadEntitiesChunkTag
EntityChunkTag
      Word8
2 -> DownloadEntitiesChunkTag -> Decoder s DownloadEntitiesChunkTag
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DownloadEntitiesChunkTag
ErrorChunkTag
      Word8
_ -> String -> Decoder s DownloadEntitiesChunkTag
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid tag"

instance Serialise DownloadEntitiesChunk where
  encode :: DownloadEntitiesChunk -> Encoding
encode (EntityC EntityChunk
ec) = DownloadEntitiesChunkTag -> Encoding
forall a. Serialise a => a -> Encoding
encode DownloadEntitiesChunkTag
EntityChunkTag Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> EntityChunk -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode EntityChunk
ec
  encode (ErrorC ErrorChunk
ec) = DownloadEntitiesChunkTag -> Encoding
forall a. Serialise a => a -> Encoding
encode DownloadEntitiesChunkTag
ErrorChunkTag Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ErrorChunk -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode ErrorChunk
ec
  encode (InitialC StreamInitInfo
ic) = DownloadEntitiesChunkTag -> Encoding
forall a. Serialise a => a -> Encoding
encode DownloadEntitiesChunkTag
InitialChunkTag Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> StreamInitInfo -> Encoding
forall a. Serialise a => a -> Encoding
encode StreamInitInfo
ic
  decode :: forall s. Decoder s DownloadEntitiesChunk
decode = do
    DownloadEntitiesChunkTag
tag <- Decoder s DownloadEntitiesChunkTag
forall s. Decoder s DownloadEntitiesChunkTag
forall a s. Serialise a => Decoder s a
decode
    case DownloadEntitiesChunkTag
tag of
      DownloadEntitiesChunkTag
InitialChunkTag -> StreamInitInfo -> DownloadEntitiesChunk
InitialC (StreamInitInfo -> DownloadEntitiesChunk)
-> Decoder s StreamInitInfo -> Decoder s DownloadEntitiesChunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s StreamInitInfo
forall s. Decoder s StreamInitInfo
forall a s. Serialise a => Decoder s a
decode
      DownloadEntitiesChunkTag
EntityChunkTag -> EntityChunk -> DownloadEntitiesChunk
EntityC (EntityChunk -> DownloadEntitiesChunk)
-> Decoder s EntityChunk -> Decoder s DownloadEntitiesChunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s EntityChunk
forall s. Decoder s EntityChunk
forall a s. Serialise a => Decoder s a
decode
      DownloadEntitiesChunkTag
ErrorChunkTag -> ErrorChunk -> DownloadEntitiesChunk
ErrorC (ErrorChunk -> DownloadEntitiesChunk)
-> Decoder s ErrorChunk -> Decoder s DownloadEntitiesChunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ErrorChunk
forall s. Decoder s ErrorChunk
forall a s. Serialise a => Decoder s a
decode

-- | An error occurred while pulling code from Unison Share.
data PullError
  = PullError'DownloadEntities DownloadEntitiesError
  | PullError'Sync SyncError
  deriving stock (Int -> PullError -> ShowS
[PullError] -> ShowS
PullError -> String
(Int -> PullError -> ShowS)
-> (PullError -> String)
-> ([PullError] -> ShowS)
-> Show PullError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PullError -> ShowS
showsPrec :: Int -> PullError -> ShowS
$cshow :: PullError -> String
show :: PullError -> String
$cshowList :: [PullError] -> ShowS
showList :: [PullError] -> ShowS
Show, PullError -> PullError -> Bool
(PullError -> PullError -> Bool)
-> (PullError -> PullError -> Bool) -> Eq PullError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PullError -> PullError -> Bool
== :: PullError -> PullError -> Bool
$c/= :: PullError -> PullError -> Bool
/= :: PullError -> PullError -> Bool
Eq, Eq PullError
Eq PullError =>
(PullError -> PullError -> Ordering)
-> (PullError -> PullError -> Bool)
-> (PullError -> PullError -> Bool)
-> (PullError -> PullError -> Bool)
-> (PullError -> PullError -> Bool)
-> (PullError -> PullError -> PullError)
-> (PullError -> PullError -> PullError)
-> Ord PullError
PullError -> PullError -> Bool
PullError -> PullError -> Ordering
PullError -> PullError -> PullError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PullError -> PullError -> Ordering
compare :: PullError -> PullError -> Ordering
$c< :: PullError -> PullError -> Bool
< :: PullError -> PullError -> Bool
$c<= :: PullError -> PullError -> Bool
<= :: PullError -> PullError -> Bool
$c> :: PullError -> PullError -> Bool
> :: PullError -> PullError -> Bool
$c>= :: PullError -> PullError -> Bool
>= :: PullError -> PullError -> Bool
$cmax :: PullError -> PullError -> PullError
max :: PullError -> PullError -> PullError
$cmin :: PullError -> PullError -> PullError
min :: PullError -> PullError -> PullError
Ord)
  deriving anyclass (Show PullError
Typeable PullError
(Typeable PullError, Show PullError) =>
(PullError -> SomeException)
-> (SomeException -> Maybe PullError)
-> (PullError -> String)
-> Exception PullError
SomeException -> Maybe PullError
PullError -> String
PullError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: PullError -> SomeException
toException :: PullError -> SomeException
$cfromException :: SomeException -> Maybe PullError
fromException :: SomeException -> Maybe PullError
$cdisplayException :: PullError -> String
displayException :: PullError -> String
Exception)

data SyncError
  = SyncErrorExpectedResultNotInMain CausalHash
  | SyncErrorDeserializationFailure CBOR.DeserialiseFailure
  | SyncErrorMissingInitialChunk
  | SyncErrorMisplacedInitialChunk
  | SyncErrorStreamFailure Text
  | SyncErrorUnsupportedVersion Version
  deriving stock (Int -> SyncError -> ShowS
[SyncError] -> ShowS
SyncError -> String
(Int -> SyncError -> ShowS)
-> (SyncError -> String)
-> ([SyncError] -> ShowS)
-> Show SyncError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SyncError -> ShowS
showsPrec :: Int -> SyncError -> ShowS
$cshow :: SyncError -> String
show :: SyncError -> String
$cshowList :: [SyncError] -> ShowS
showList :: [SyncError] -> ShowS
Show, SyncError -> SyncError -> Bool
(SyncError -> SyncError -> Bool)
-> (SyncError -> SyncError -> Bool) -> Eq SyncError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SyncError -> SyncError -> Bool
== :: SyncError -> SyncError -> Bool
$c/= :: SyncError -> SyncError -> Bool
/= :: SyncError -> SyncError -> Bool
Eq, Eq SyncError
Eq SyncError =>
(SyncError -> SyncError -> Ordering)
-> (SyncError -> SyncError -> Bool)
-> (SyncError -> SyncError -> Bool)
-> (SyncError -> SyncError -> Bool)
-> (SyncError -> SyncError -> Bool)
-> (SyncError -> SyncError -> SyncError)
-> (SyncError -> SyncError -> SyncError)
-> Ord SyncError
SyncError -> SyncError -> Bool
SyncError -> SyncError -> Ordering
SyncError -> SyncError -> SyncError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SyncError -> SyncError -> Ordering
compare :: SyncError -> SyncError -> Ordering
$c< :: SyncError -> SyncError -> Bool
< :: SyncError -> SyncError -> Bool
$c<= :: SyncError -> SyncError -> Bool
<= :: SyncError -> SyncError -> Bool
$c> :: SyncError -> SyncError -> Bool
> :: SyncError -> SyncError -> Bool
$c>= :: SyncError -> SyncError -> Bool
>= :: SyncError -> SyncError -> Bool
$cmax :: SyncError -> SyncError -> SyncError
max :: SyncError -> SyncError -> SyncError
$cmin :: SyncError -> SyncError -> SyncError
min :: SyncError -> SyncError -> SyncError
Ord)

data EntityKind
  = CausalEntity
  | NamespaceEntity
  | TermEntity
  | TypeEntity
  | PatchEntity
  deriving (Int -> EntityKind -> ShowS
[EntityKind] -> ShowS
EntityKind -> String
(Int -> EntityKind -> ShowS)
-> (EntityKind -> String)
-> ([EntityKind] -> ShowS)
-> Show EntityKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntityKind -> ShowS
showsPrec :: Int -> EntityKind -> ShowS
$cshow :: EntityKind -> String
show :: EntityKind -> String
$cshowList :: [EntityKind] -> ShowS
showList :: [EntityKind] -> ShowS
Show, EntityKind -> EntityKind -> Bool
(EntityKind -> EntityKind -> Bool)
-> (EntityKind -> EntityKind -> Bool) -> Eq EntityKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EntityKind -> EntityKind -> Bool
== :: EntityKind -> EntityKind -> Bool
$c/= :: EntityKind -> EntityKind -> Bool
/= :: EntityKind -> EntityKind -> Bool
Eq, Eq EntityKind
Eq EntityKind =>
(EntityKind -> EntityKind -> Ordering)
-> (EntityKind -> EntityKind -> Bool)
-> (EntityKind -> EntityKind -> Bool)
-> (EntityKind -> EntityKind -> Bool)
-> (EntityKind -> EntityKind -> Bool)
-> (EntityKind -> EntityKind -> EntityKind)
-> (EntityKind -> EntityKind -> EntityKind)
-> Ord EntityKind
EntityKind -> EntityKind -> Bool
EntityKind -> EntityKind -> Ordering
EntityKind -> EntityKind -> EntityKind
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EntityKind -> EntityKind -> Ordering
compare :: EntityKind -> EntityKind -> Ordering
$c< :: EntityKind -> EntityKind -> Bool
< :: EntityKind -> EntityKind -> Bool
$c<= :: EntityKind -> EntityKind -> Bool
<= :: EntityKind -> EntityKind -> Bool
$c> :: EntityKind -> EntityKind -> Bool
> :: EntityKind -> EntityKind -> Bool
$c>= :: EntityKind -> EntityKind -> Bool
>= :: EntityKind -> EntityKind -> Bool
$cmax :: EntityKind -> EntityKind -> EntityKind
max :: EntityKind -> EntityKind -> EntityKind
$cmin :: EntityKind -> EntityKind -> EntityKind
min :: EntityKind -> EntityKind -> EntityKind
Ord)

instance Serialise EntityKind where
  encode :: EntityKind -> Encoding
encode = \case
    EntityKind
CausalEntity -> Word8 -> Encoding
CBOR.encodeWord8 Word8
0
    EntityKind
NamespaceEntity -> Word8 -> Encoding
CBOR.encodeWord8 Word8
1
    EntityKind
TermEntity -> Word8 -> Encoding
CBOR.encodeWord8 Word8
2
    EntityKind
TypeEntity -> Word8 -> Encoding
CBOR.encodeWord8 Word8
3
    EntityKind
PatchEntity -> Word8 -> Encoding
CBOR.encodeWord8 Word8
4
  decode :: forall s. Decoder s EntityKind
decode = do
    Word8
tag <- Decoder s Word8
forall s. Decoder s Word8
CBOR.decodeWord8
    case Word8
tag of
      Word8
0 -> EntityKind -> Decoder s EntityKind
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EntityKind
CausalEntity
      Word8
1 -> EntityKind -> Decoder s EntityKind
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EntityKind
NamespaceEntity
      Word8
2 -> EntityKind -> Decoder s EntityKind
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EntityKind
TermEntity
      Word8
3 -> EntityKind -> Decoder s EntityKind
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EntityKind
TypeEntity
      Word8
4 -> EntityKind -> Decoder s EntityKind
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EntityKind
PatchEntity
      Word8
_ -> String -> Decoder s EntityKind
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid tag"

------------------------------------------------------------------------------------------------------------------------
-- Causal Dependencies

data CausalDependenciesRequest = CausalDependenciesRequest
  { CausalDependenciesRequest -> BranchRef
branchRef :: BranchRef,
    CausalDependenciesRequest -> HashJWT
rootCausal :: HashJWT
  }
  deriving stock (Int -> CausalDependenciesRequest -> ShowS
[CausalDependenciesRequest] -> ShowS
CausalDependenciesRequest -> String
(Int -> CausalDependenciesRequest -> ShowS)
-> (CausalDependenciesRequest -> String)
-> ([CausalDependenciesRequest] -> ShowS)
-> Show CausalDependenciesRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CausalDependenciesRequest -> ShowS
showsPrec :: Int -> CausalDependenciesRequest -> ShowS
$cshow :: CausalDependenciesRequest -> String
show :: CausalDependenciesRequest -> String
$cshowList :: [CausalDependenciesRequest] -> ShowS
showList :: [CausalDependenciesRequest] -> ShowS
Show, CausalDependenciesRequest -> CausalDependenciesRequest -> Bool
(CausalDependenciesRequest -> CausalDependenciesRequest -> Bool)
-> (CausalDependenciesRequest -> CausalDependenciesRequest -> Bool)
-> Eq CausalDependenciesRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CausalDependenciesRequest -> CausalDependenciesRequest -> Bool
== :: CausalDependenciesRequest -> CausalDependenciesRequest -> Bool
$c/= :: CausalDependenciesRequest -> CausalDependenciesRequest -> Bool
/= :: CausalDependenciesRequest -> CausalDependenciesRequest -> Bool
Eq, Eq CausalDependenciesRequest
Eq CausalDependenciesRequest =>
(CausalDependenciesRequest
 -> CausalDependenciesRequest -> Ordering)
-> (CausalDependenciesRequest -> CausalDependenciesRequest -> Bool)
-> (CausalDependenciesRequest -> CausalDependenciesRequest -> Bool)
-> (CausalDependenciesRequest -> CausalDependenciesRequest -> Bool)
-> (CausalDependenciesRequest -> CausalDependenciesRequest -> Bool)
-> (CausalDependenciesRequest
    -> CausalDependenciesRequest -> CausalDependenciesRequest)
-> (CausalDependenciesRequest
    -> CausalDependenciesRequest -> CausalDependenciesRequest)
-> Ord CausalDependenciesRequest
CausalDependenciesRequest -> CausalDependenciesRequest -> Bool
CausalDependenciesRequest -> CausalDependenciesRequest -> Ordering
CausalDependenciesRequest
-> CausalDependenciesRequest -> CausalDependenciesRequest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CausalDependenciesRequest -> CausalDependenciesRequest -> Ordering
compare :: CausalDependenciesRequest -> CausalDependenciesRequest -> Ordering
$c< :: CausalDependenciesRequest -> CausalDependenciesRequest -> Bool
< :: CausalDependenciesRequest -> CausalDependenciesRequest -> Bool
$c<= :: CausalDependenciesRequest -> CausalDependenciesRequest -> Bool
<= :: CausalDependenciesRequest -> CausalDependenciesRequest -> Bool
$c> :: CausalDependenciesRequest -> CausalDependenciesRequest -> Bool
> :: CausalDependenciesRequest -> CausalDependenciesRequest -> Bool
$c>= :: CausalDependenciesRequest -> CausalDependenciesRequest -> Bool
>= :: CausalDependenciesRequest -> CausalDependenciesRequest -> Bool
$cmax :: CausalDependenciesRequest
-> CausalDependenciesRequest -> CausalDependenciesRequest
max :: CausalDependenciesRequest
-> CausalDependenciesRequest -> CausalDependenciesRequest
$cmin :: CausalDependenciesRequest
-> CausalDependenciesRequest -> CausalDependenciesRequest
min :: CausalDependenciesRequest
-> CausalDependenciesRequest -> CausalDependenciesRequest
Ord)

instance ToJSON CausalDependenciesRequest where
  toJSON :: CausalDependenciesRequest -> Value
toJSON (CausalDependenciesRequest BranchRef
branchRef HashJWT
rootCausal) =
    [Pair] -> Value
object
      [ Key
"branch_ref" Key -> BranchRef -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BranchRef
branchRef,
        Key
"root_causal" Key -> HashJWT -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= HashJWT
rootCausal
      ]

instance FromJSON CausalDependenciesRequest where
  parseJSON :: Value -> Parser CausalDependenciesRequest
parseJSON = String
-> (Object -> Parser CausalDependenciesRequest)
-> Value
-> Parser CausalDependenciesRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"CausalDependenciesRequest" \Object
obj -> do
    BranchRef
branchRef <- Object
obj Object -> Key -> Parser BranchRef
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"branch_ref"
    HashJWT
rootCausal <- Object
obj Object -> Key -> Parser HashJWT
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"root_causal"
    CausalDependenciesRequest -> Parser CausalDependenciesRequest
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CausalDependenciesRequest {HashJWT
BranchRef
$sel:branchRef:CausalDependenciesRequest :: BranchRef
$sel:rootCausal:CausalDependenciesRequest :: HashJWT
branchRef :: BranchRef
rootCausal :: HashJWT
..}

instance Serialise CausalDependenciesRequest where
  encode :: CausalDependenciesRequest -> Encoding
encode (CausalDependenciesRequest {BranchRef
$sel:branchRef:CausalDependenciesRequest :: CausalDependenciesRequest -> BranchRef
branchRef :: BranchRef
branchRef, HashJWT
$sel:rootCausal:CausalDependenciesRequest :: CausalDependenciesRequest -> HashJWT
rootCausal :: HashJWT
rootCausal}) =
    BranchRef -> Encoding
forall a. Serialise a => a -> Encoding
encode BranchRef
branchRef Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> HashJWT -> Encoding
forall a. Serialise a => a -> Encoding
encode HashJWT
rootCausal
  decode :: forall s. Decoder s CausalDependenciesRequest
decode = BranchRef -> HashJWT -> CausalDependenciesRequest
CausalDependenciesRequest (BranchRef -> HashJWT -> CausalDependenciesRequest)
-> Decoder s BranchRef
-> Decoder s (HashJWT -> CausalDependenciesRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s BranchRef
forall s. Decoder s BranchRef
forall a s. Serialise a => Decoder s a
decode Decoder s (HashJWT -> CausalDependenciesRequest)
-> Decoder s HashJWT -> Decoder s CausalDependenciesRequest
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s HashJWT
forall s. Decoder s HashJWT
forall a s. Serialise a => Decoder s a
decode

data DependencyType
  = -- This is a top-level history node of the root we're pulling.
    CausalSpineDependency
  | -- This is the causal root of a library dependency.
    LibDependency
  deriving (Int -> DependencyType -> ShowS
[DependencyType] -> ShowS
DependencyType -> String
(Int -> DependencyType -> ShowS)
-> (DependencyType -> String)
-> ([DependencyType] -> ShowS)
-> Show DependencyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DependencyType -> ShowS
showsPrec :: Int -> DependencyType -> ShowS
$cshow :: DependencyType -> String
show :: DependencyType -> String
$cshowList :: [DependencyType] -> ShowS
showList :: [DependencyType] -> ShowS
Show, DependencyType -> DependencyType -> Bool
(DependencyType -> DependencyType -> Bool)
-> (DependencyType -> DependencyType -> Bool) -> Eq DependencyType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DependencyType -> DependencyType -> Bool
== :: DependencyType -> DependencyType -> Bool
$c/= :: DependencyType -> DependencyType -> Bool
/= :: DependencyType -> DependencyType -> Bool
Eq, Eq DependencyType
Eq DependencyType =>
(DependencyType -> DependencyType -> Ordering)
-> (DependencyType -> DependencyType -> Bool)
-> (DependencyType -> DependencyType -> Bool)
-> (DependencyType -> DependencyType -> Bool)
-> (DependencyType -> DependencyType -> Bool)
-> (DependencyType -> DependencyType -> DependencyType)
-> (DependencyType -> DependencyType -> DependencyType)
-> Ord DependencyType
DependencyType -> DependencyType -> Bool
DependencyType -> DependencyType -> Ordering
DependencyType -> DependencyType -> DependencyType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DependencyType -> DependencyType -> Ordering
compare :: DependencyType -> DependencyType -> Ordering
$c< :: DependencyType -> DependencyType -> Bool
< :: DependencyType -> DependencyType -> Bool
$c<= :: DependencyType -> DependencyType -> Bool
<= :: DependencyType -> DependencyType -> Bool
$c> :: DependencyType -> DependencyType -> Bool
> :: DependencyType -> DependencyType -> Bool
$c>= :: DependencyType -> DependencyType -> Bool
>= :: DependencyType -> DependencyType -> Bool
$cmax :: DependencyType -> DependencyType -> DependencyType
max :: DependencyType -> DependencyType -> DependencyType
$cmin :: DependencyType -> DependencyType -> DependencyType
min :: DependencyType -> DependencyType -> DependencyType
Ord)

instance Serialise DependencyType where
  encode :: DependencyType -> Encoding
encode = \case
    DependencyType
CausalSpineDependency -> Word8 -> Encoding
CBOR.encodeWord8 Word8
0
    DependencyType
LibDependency -> Word8 -> Encoding
CBOR.encodeWord8 Word8
1
  decode :: forall s. Decoder s DependencyType
decode = do
    Word8
tag <- Decoder s Word8
forall s. Decoder s Word8
CBOR.decodeWord8
    case Word8
tag of
      Word8
0 -> DependencyType -> Decoder s DependencyType
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DependencyType
CausalSpineDependency
      Word8
1 -> DependencyType -> Decoder s DependencyType
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DependencyType
LibDependency
      Word8
_ -> String -> Decoder s DependencyType
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid tag"

instance ToJSON DependencyType where
  toJSON :: DependencyType -> Value
toJSON = \case
    DependencyType
CausalSpineDependency -> Value
"causal_spine"
    DependencyType
LibDependency -> Value
"lib"

instance FromJSON DependencyType where
  parseJSON :: Value -> Parser DependencyType
parseJSON = String
-> (Text -> Parser DependencyType)
-> Value
-> Parser DependencyType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"DependencyType" \case
    Text
"causal_spine" -> DependencyType -> Parser DependencyType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DependencyType
CausalSpineDependency
    Text
"lib" -> DependencyType -> Parser DependencyType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DependencyType
LibDependency
    Text
_ -> String -> Parser DependencyType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid DependencyType"

-- | A chunk of the download entities response stream.
data CausalDependenciesChunk
  = CausalHashDepC {CausalDependenciesChunk -> Hash32
causalHash :: Hash32, CausalDependenciesChunk -> DependencyType
dependencyType :: DependencyType}
  deriving (Int -> CausalDependenciesChunk -> ShowS
[CausalDependenciesChunk] -> ShowS
CausalDependenciesChunk -> String
(Int -> CausalDependenciesChunk -> ShowS)
-> (CausalDependenciesChunk -> String)
-> ([CausalDependenciesChunk] -> ShowS)
-> Show CausalDependenciesChunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CausalDependenciesChunk -> ShowS
showsPrec :: Int -> CausalDependenciesChunk -> ShowS
$cshow :: CausalDependenciesChunk -> String
show :: CausalDependenciesChunk -> String
$cshowList :: [CausalDependenciesChunk] -> ShowS
showList :: [CausalDependenciesChunk] -> ShowS
Show, CausalDependenciesChunk -> CausalDependenciesChunk -> Bool
(CausalDependenciesChunk -> CausalDependenciesChunk -> Bool)
-> (CausalDependenciesChunk -> CausalDependenciesChunk -> Bool)
-> Eq CausalDependenciesChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CausalDependenciesChunk -> CausalDependenciesChunk -> Bool
== :: CausalDependenciesChunk -> CausalDependenciesChunk -> Bool
$c/= :: CausalDependenciesChunk -> CausalDependenciesChunk -> Bool
/= :: CausalDependenciesChunk -> CausalDependenciesChunk -> Bool
Eq, Eq CausalDependenciesChunk
Eq CausalDependenciesChunk =>
(CausalDependenciesChunk -> CausalDependenciesChunk -> Ordering)
-> (CausalDependenciesChunk -> CausalDependenciesChunk -> Bool)
-> (CausalDependenciesChunk -> CausalDependenciesChunk -> Bool)
-> (CausalDependenciesChunk -> CausalDependenciesChunk -> Bool)
-> (CausalDependenciesChunk -> CausalDependenciesChunk -> Bool)
-> (CausalDependenciesChunk
    -> CausalDependenciesChunk -> CausalDependenciesChunk)
-> (CausalDependenciesChunk
    -> CausalDependenciesChunk -> CausalDependenciesChunk)
-> Ord CausalDependenciesChunk
CausalDependenciesChunk -> CausalDependenciesChunk -> Bool
CausalDependenciesChunk -> CausalDependenciesChunk -> Ordering
CausalDependenciesChunk
-> CausalDependenciesChunk -> CausalDependenciesChunk
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CausalDependenciesChunk -> CausalDependenciesChunk -> Ordering
compare :: CausalDependenciesChunk -> CausalDependenciesChunk -> Ordering
$c< :: CausalDependenciesChunk -> CausalDependenciesChunk -> Bool
< :: CausalDependenciesChunk -> CausalDependenciesChunk -> Bool
$c<= :: CausalDependenciesChunk -> CausalDependenciesChunk -> Bool
<= :: CausalDependenciesChunk -> CausalDependenciesChunk -> Bool
$c> :: CausalDependenciesChunk -> CausalDependenciesChunk -> Bool
> :: CausalDependenciesChunk -> CausalDependenciesChunk -> Bool
$c>= :: CausalDependenciesChunk -> CausalDependenciesChunk -> Bool
>= :: CausalDependenciesChunk -> CausalDependenciesChunk -> Bool
$cmax :: CausalDependenciesChunk
-> CausalDependenciesChunk -> CausalDependenciesChunk
max :: CausalDependenciesChunk
-> CausalDependenciesChunk -> CausalDependenciesChunk
$cmin :: CausalDependenciesChunk
-> CausalDependenciesChunk -> CausalDependenciesChunk
min :: CausalDependenciesChunk
-> CausalDependenciesChunk -> CausalDependenciesChunk
Ord)

data CausalDependenciesChunkTag = CausalHashDepChunkTag
  deriving (Int -> CausalDependenciesChunkTag -> ShowS
[CausalDependenciesChunkTag] -> ShowS
CausalDependenciesChunkTag -> String
(Int -> CausalDependenciesChunkTag -> ShowS)
-> (CausalDependenciesChunkTag -> String)
-> ([CausalDependenciesChunkTag] -> ShowS)
-> Show CausalDependenciesChunkTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CausalDependenciesChunkTag -> ShowS
showsPrec :: Int -> CausalDependenciesChunkTag -> ShowS
$cshow :: CausalDependenciesChunkTag -> String
show :: CausalDependenciesChunkTag -> String
$cshowList :: [CausalDependenciesChunkTag] -> ShowS
showList :: [CausalDependenciesChunkTag] -> ShowS
Show, CausalDependenciesChunkTag -> CausalDependenciesChunkTag -> Bool
(CausalDependenciesChunkTag -> CausalDependenciesChunkTag -> Bool)
-> (CausalDependenciesChunkTag
    -> CausalDependenciesChunkTag -> Bool)
-> Eq CausalDependenciesChunkTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CausalDependenciesChunkTag -> CausalDependenciesChunkTag -> Bool
== :: CausalDependenciesChunkTag -> CausalDependenciesChunkTag -> Bool
$c/= :: CausalDependenciesChunkTag -> CausalDependenciesChunkTag -> Bool
/= :: CausalDependenciesChunkTag -> CausalDependenciesChunkTag -> Bool
Eq, Eq CausalDependenciesChunkTag
Eq CausalDependenciesChunkTag =>
(CausalDependenciesChunkTag
 -> CausalDependenciesChunkTag -> Ordering)
-> (CausalDependenciesChunkTag
    -> CausalDependenciesChunkTag -> Bool)
-> (CausalDependenciesChunkTag
    -> CausalDependenciesChunkTag -> Bool)
-> (CausalDependenciesChunkTag
    -> CausalDependenciesChunkTag -> Bool)
-> (CausalDependenciesChunkTag
    -> CausalDependenciesChunkTag -> Bool)
-> (CausalDependenciesChunkTag
    -> CausalDependenciesChunkTag -> CausalDependenciesChunkTag)
-> (CausalDependenciesChunkTag
    -> CausalDependenciesChunkTag -> CausalDependenciesChunkTag)
-> Ord CausalDependenciesChunkTag
CausalDependenciesChunkTag -> CausalDependenciesChunkTag -> Bool
CausalDependenciesChunkTag
-> CausalDependenciesChunkTag -> Ordering
CausalDependenciesChunkTag
-> CausalDependenciesChunkTag -> CausalDependenciesChunkTag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CausalDependenciesChunkTag
-> CausalDependenciesChunkTag -> Ordering
compare :: CausalDependenciesChunkTag
-> CausalDependenciesChunkTag -> Ordering
$c< :: CausalDependenciesChunkTag -> CausalDependenciesChunkTag -> Bool
< :: CausalDependenciesChunkTag -> CausalDependenciesChunkTag -> Bool
$c<= :: CausalDependenciesChunkTag -> CausalDependenciesChunkTag -> Bool
<= :: CausalDependenciesChunkTag -> CausalDependenciesChunkTag -> Bool
$c> :: CausalDependenciesChunkTag -> CausalDependenciesChunkTag -> Bool
> :: CausalDependenciesChunkTag -> CausalDependenciesChunkTag -> Bool
$c>= :: CausalDependenciesChunkTag -> CausalDependenciesChunkTag -> Bool
>= :: CausalDependenciesChunkTag -> CausalDependenciesChunkTag -> Bool
$cmax :: CausalDependenciesChunkTag
-> CausalDependenciesChunkTag -> CausalDependenciesChunkTag
max :: CausalDependenciesChunkTag
-> CausalDependenciesChunkTag -> CausalDependenciesChunkTag
$cmin :: CausalDependenciesChunkTag
-> CausalDependenciesChunkTag -> CausalDependenciesChunkTag
min :: CausalDependenciesChunkTag
-> CausalDependenciesChunkTag -> CausalDependenciesChunkTag
Ord)

instance Serialise CausalDependenciesChunkTag where
  encode :: CausalDependenciesChunkTag -> Encoding
encode = \case
    CausalDependenciesChunkTag
CausalHashDepChunkTag -> Word8 -> Encoding
CBOR.encodeWord8 Word8
0
  decode :: forall s. Decoder s CausalDependenciesChunkTag
decode = do
    Word8
tag <- Decoder s Word8
forall s. Decoder s Word8
CBOR.decodeWord8
    case Word8
tag of
      Word8
0 -> CausalDependenciesChunkTag -> Decoder s CausalDependenciesChunkTag
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CausalDependenciesChunkTag
CausalHashDepChunkTag
      Word8
_ -> String -> Decoder s CausalDependenciesChunkTag
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid tag"

instance Serialise CausalDependenciesChunk where
  encode :: CausalDependenciesChunk -> Encoding
encode = \case
    (CausalHashDepC {Hash32
$sel:causalHash:CausalHashDepC :: CausalDependenciesChunk -> Hash32
causalHash :: Hash32
causalHash, DependencyType
$sel:dependencyType:CausalHashDepC :: CausalDependenciesChunk -> DependencyType
dependencyType :: DependencyType
dependencyType}) -> do
      CausalDependenciesChunkTag -> Encoding
forall a. Serialise a => a -> Encoding
encode CausalDependenciesChunkTag
CausalHashDepChunkTag Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Hash32 -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode Hash32
causalHash Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DependencyType -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode DependencyType
dependencyType
  decode :: forall s. Decoder s CausalDependenciesChunk
decode = do
    CausalDependenciesChunkTag
tag <- Decoder s CausalDependenciesChunkTag
forall s. Decoder s CausalDependenciesChunkTag
forall a s. Serialise a => Decoder s a
decode
    case CausalDependenciesChunkTag
tag of
      CausalDependenciesChunkTag
CausalHashDepChunkTag -> Hash32 -> DependencyType -> CausalDependenciesChunk
CausalHashDepC (Hash32 -> DependencyType -> CausalDependenciesChunk)
-> Decoder s Hash32
-> Decoder s (DependencyType -> CausalDependenciesChunk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Hash32
forall s. Decoder s Hash32
forall a s. Serialise a => Decoder s a
CBOR.decode Decoder s (DependencyType -> CausalDependenciesChunk)
-> Decoder s DependencyType -> Decoder s CausalDependenciesChunk
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s DependencyType
forall s. Decoder s DependencyType
forall a s. Serialise a => Decoder s a
CBOR.decode