Commit dc7540f6 authored by Marc Coiffier's avatar Marc Coiffier
Browse files

Overhaul the Serializable interface to allow for non-ByteString-based serialization

parent 64738170
......@@ -59,8 +59,8 @@ instance Foldable (ExprNode s) where
instance Traversable (ExprNode s) where
sequence (Lambda s a) = Lambda s<$>a
sequence (Apply ff fx) = Apply<$>ff<*>fx
instance (Serializable a,Serializable s) => Serializable (ExprNode s a)
instance (Format a,Format s) => Format (ExprNode s a)
instance (Serializable Word8 Builder Bytes a,Serializable Word8 Builder Bytes s) => Serializable Word8 Builder Bytes (ExprNode s a)
instance (Format Word8 Builder Bytes a,Format Word8 Builder Bytes s) => Format Word8 Builder Bytes (ExprNode s a)
c'Expression :: Constraint (Expression a b)
c'Expression = c'_
......@@ -203,14 +203,14 @@ curlyCommitDir = curlyDirPath (curlyUserDir + "/commits")
-- | A Curly log level
data LogLevel = Quiet | Chatty | Verbose | Debug
deriving (Eq,Ord,Show,Generic)
instance Serializable LogLevel
instance Format LogLevel
instance Serializable Word8 Builder Bytes LogLevel
instance Format Word8 Builder Bytes LogLevel
data LogMessage = LogLine LogLevel String
| LogActionStart String
| LogActionEnd String Bool
deriving (Show,Generic)
instance Format LogMessage
instance Serializable LogMessage
instance Format Word8 Builder Bytes LogMessage
instance Serializable Word8 Builder Bytes LogMessage
-- The global log level, as set by the environment variable CURLY_LOGLEVEL
envLogLevel :: LogLevel
......@@ -368,7 +368,7 @@ instance HasIdents s s' t t' => HasIdents s s' (Maybe t) (Maybe t') where
data RelocationSize = RS_16 | RS_32 | RS_64
deriving (Eq,Ord,Show,Generic)
instance Serializable RelocationSize ; instance Format RelocationSize
instance Serializable Word8 Builder Bytes RelocationSize ; instance Format Word8 Builder Bytes RelocationSize
data BinaryRelocation = BinaryRelocation {
_br_PCRelative :: Bool,
_br_size :: RelocationSize,
......@@ -376,8 +376,8 @@ data BinaryRelocation = BinaryRelocation {
_br_symoffset :: Int
}
deriving (Eq,Ord,Show,Generic)
instance Serializable BinaryRelocation
instance Format BinaryRelocation
instance Serializable Word8 Builder Bytes BinaryRelocation
instance Format Word8 Builder Bytes BinaryRelocation
-- | The type of all Curly builtins
data Builtin = B_Undefined
| B_Seq
......@@ -421,15 +421,15 @@ instance Documented Builtin where
where show' (B_Number n) = show n
show' (B_String s) = show s
show' b = show b
instance Serializable Builtin where
instance Format Builtin where
instance Serializable Word8 Builder Bytes Builtin where
instance Format Word8 Builder Bytes Builtin where
instance NFData Builtin where rnf b = b`seq`()
newtype Compressed a = Compressed { unCompressed :: a }
deriving (Show,Eq,Ord)
instance Serializable a => Serializable (Compressed a) where
encode (Compressed a) = encode (compress (serialize a))
instance Format a => Format (Compressed a) where
instance Serializable Word8 Builder Bytes a => Serializable Word8 Builder Bytes (Compressed a) where
encode p (Compressed a) = encode p (compress (serialize a))
instance Format Word8 Builder Bytes a => Format Word8 Builder Bytes (Compressed a) where
datum = (datum <&> decompress) >*> (Compressed <$> datum)
noCurlySuf :: FilePath -> Maybe FilePath
......@@ -445,18 +445,18 @@ instance Show Hash where
show (Hash h) = show (B64Chunk h)
instance Read Hash where
readsPrec _ = readsParser (readable <&> \(B64Chunk h) -> Hash h)
instance Serializable Hash where
encode (Hash h) = h^.chunkBuilder
instance Format Hash where
instance Serializable Word8 Builder Bytes Hash where
encode _ (Hash h) = h^.chunkBuilder
instance Format Word8 Builder Bytes Hash where
datum = Hash<$>getChunk 32
newtype LibraryID = LibraryID Chunk
deriving (Eq,Ord,Generic)
idSize :: Int
idSize = 32
instance Serializable LibraryID where
encode (LibraryID x) = x^.chunkBuilder
instance Format LibraryID where
instance Serializable Word8 Builder Bytes LibraryID where
encode _ (LibraryID x) = x^.chunkBuilder
instance Format Word8 Builder Bytes LibraryID where
datum = LibraryID<$>getChunk idSize
instance NFData LibraryID
instance Show LibraryID where
......@@ -473,8 +473,8 @@ instance Documented GlobalID where
else \(GlobalID n _) -> Pure n
where showL (Just (n,l)) = "["+show l+":"+n+"]"
showL _ = "[]"
instance Serializable GlobalID
instance Format GlobalID
instance Serializable Word8 Builder Bytes GlobalID
instance Format Word8 Builder Bytes GlobalID
instance NFData GlobalID
instance Identifier GlobalID where
pureIdent n = GlobalID n Nothing
......
......@@ -55,8 +55,8 @@ instance Show (Symbol s) where
show (Builtin _ b) = "#"+show b
instance Documented (Symbol s) where
document s = Pure (show s)
instance (Serializable s,Identifier s) => Serializable (Symbol s)
instance (Format s,Identifier s) => Format (Symbol s)
instance (Serializable Word8 Builder Bytes s,Identifier s) => Serializable Word8 Builder Bytes (Symbol s)
instance (Format Word8 Builder Bytes s,Identifier s) => Format Word8 Builder Bytes (Symbol s)
instance NFData (Symbol s) where
rnf (Argument n) = rnf n
rnf (Builtin _ b) = rnf b
......@@ -80,8 +80,8 @@ instance HasIdents s s' (StrictnessHead s) (StrictnessHead s') where
(ff'idents k sts)
ff'idents _ StH_Void = pure StH_Void
ff'idents _ (StH_Val n) = pure (StH_Val n)
instance Serializable s => Serializable (StrictnessHead s)
instance Format s => Format (StrictnessHead s)
instance Serializable Word8 Builder Bytes s => Serializable Word8 Builder Bytes (StrictnessHead s)
instance Format Word8 Builder Bytes s => Format Word8 Builder Bytes (StrictnessHead s)
instance NFData s => NFData (StrictnessHead s)
noStrictness :: Strictness s
......@@ -90,8 +90,8 @@ noStrictness = HNF StH_Void []
data Strictness s = Delayed s (ExprStrictness s)
| HNF (StrictnessHead s) [ExprStrictness s]
deriving (Eq,Ord,Generic)
instance Serializable s => Serializable (Strictness s)
instance Format s => Format (Strictness s)
instance Serializable Word8 Builder Bytes s => Serializable Word8 Builder Bytes (Strictness s)
instance Format Word8 Builder Bytes s => Format Word8 Builder Bytes (Strictness s)
instance NFData s => NFData (Strictness s)
instance HasIdents s s' (Strictness s) (Strictness s') where
ff'idents k (Delayed s es) = liftA2 Delayed (k s) ((l'1.each.ff'idents .+ l'2.ff'idents) k es)
......
......@@ -26,8 +26,8 @@ import System.Environment (lookupEnv)
-- | A documentation node (similar to a HTML node, but simpler)
data DocNode a = DocTag String [(String,String)] [a]
deriving (Eq,Ord,Show,Generic)
instance Serializable a => Serializable (DocNode a)
instance Format a => Format (DocNode a)
instance Serializable Word8 Builder Bytes a => Serializable Word8 Builder Bytes (DocNode a)
instance Format Word8 Builder Bytes a => Format Word8 Builder Bytes (DocNode a)
instance Functor DocNode where map f (DocTag t a xs) = DocTag t a (map f xs)
instance Foldable DocNode where fold (DocTag _ _ l) = fold l
instance Traversable DocNode where sequence (DocTag t as l) = DocTag t as<$>sequence l
......@@ -51,10 +51,10 @@ instance Documented Int where
document n = docTag' "int" [Pure (show n)]
newtype Metadata = Metadata (Forest (Map String) String)
deriving (Semigroup,Monoid,Serializable)
deriving (Semigroup,Monoid,Serializable Word8 Builder Bytes)
i'Metadata :: Iso' (Forest (Map String) String) Metadata
i'Metadata = iso Metadata (\(Metadata m) -> m)
instance Format Metadata where datum = coerceDatum Metadata
instance Format Word8 Builder Bytes Metadata where datum = coerceDatum Metadata
instance DataMap Metadata String (Free (Map String) String) where
at i = from i'Metadata.at i
instance Show Metadata where
......
......@@ -42,15 +42,15 @@ curlyLibVersion = 11
binaryEOI :: (MonadParser s m p, Monoid s, Eq s) => p ()
binaryEOI = guard . (==zero) =<< remaining
newtype Chunked a = Chunked { getChunked :: a }
instance Serializable a => Serializable (Chunked a) where
encode (Chunked a) = encode (serialize a)
instance Format a => Format (Chunked a) where
datum = datum <&> \x -> maybe (error "No parse for chunked data") Chunked (matches Just (datum <* binaryEOI) x)
instance Serializable Word8 Builder Bytes a => Serializable Word8 Builder Bytes (Chunked a) where
encode p (Chunked a) = encode p (serialize a :: Bytes)
instance Format Word8 Builder Bytes a => Format Word8 Builder Bytes (Chunked a) where
datum = datum <&> \x -> maybe (error "No parse for chunked data") Chunked (matches Just (datum <* binaryEOI) (x :: Bytes))
data FutureExtensionTail = FutureExtensionTail
instance Serializable FutureExtensionTail where
instance Serializable Word8 Builder Bytes FutureExtensionTail where
encode = zero
instance Format FutureExtensionTail where
instance Format Word8 Builder Bytes FutureExtensionTail where
datum = runStreamState (put zero) >> return FutureExtensionTail
type FutureExtension = Extension FutureExtensionTail
......@@ -64,9 +64,10 @@ instance ExtensionDefault a => ExtensionDefault (Extension a) where
extensionDefault = Extension (Chunked extensionDefault)
newtype Extension a = Extension (Chunked a)
deriving Serializable
instance (ExtensionDefault a,Format a) => Format (Extension a) where
datum = datum <&> \x -> maybe (error "No parse for extension") (Extension . Chunked) (matches Just (datum <+? fill extensionDefault binaryEOI) x)
deriving instance Serializable Word8 Builder Bytes a => Serializable Word8 Builder Bytes (Extension a)
instance (ExtensionDefault a,Format Word8 Builder Bytes a) => Format Word8 Builder Bytes (Extension a) where
datum = datum <&> \x -> maybe (error "No parse for extension") (Extension . Chunked) (matches Just (datum <+? fill extensionDefault binaryEOI) (x :: Bytes))
newtype ModDir s a = ModDir [(s,a)]
deriving (Semigroup,Monoid,Show)
......@@ -82,9 +83,9 @@ instance Documented a => Documented (Module a) where
,docTag' "ul" (map (docTag "li" [("class","modVal")] . pure . doc') l')]
document (Pure s) = document s
instance (Serializable s,Serializable a) => Serializable (ModDir s a) where
instance (Serializable Word8 Builder Bytes s,Serializable Word8 Builder Bytes a) => Serializable Word8 Builder Bytes (ModDir s a) where
encode = coerceEncode (ModDir . getChunked)
instance (Format s,Format a) => Format (ModDir s a) where
instance (Format Word8 Builder Bytes s,Format Word8 Builder Bytes a) => Format Word8 Builder Bytes (ModDir s a) where
datum = coerceDatum (ModDir . getChunked)
instance Functor (ModDir s) where map f (ModDir l) = ModDir (l <&> l'2 %~ f)
instance Ord s => SemiApplicative (Zip (ModDir s)) where
......@@ -138,9 +139,9 @@ instance Functor (ModLeaf s) where
map = warp leafVal
instance Foldable (ModLeaf s) where fold l = l^.leafVal
instance Traversable (ModLeaf s) where sequence l = leafVal id l
instance (Identifier s,Serializable s,Serializable a) => Serializable (ModLeaf s a) where
encode (ModLeaf a b c d e f g) = encode (Chunked a)+encode b+encode (Chunked c)+encode d+encode e+encode f+encode (Chunked g)
instance (Identifier s,Format s,Format a) => Format (ModLeaf s a) where
instance (Identifier s,Serializable Word8 Builder Bytes s,Serializable Word8 Builder Bytes a) => Serializable Word8 Builder Bytes (ModLeaf s a) where
encode p (ModLeaf a b c d e f g) = encode p (Chunked a,b,Chunked c,d,e,f,Chunked g)
instance (Identifier s,Format Word8 Builder Bytes s,Format Word8 Builder Bytes a) => Format Word8 Builder Bytes (ModLeaf s a) where
datum = (\(Chunked a) b (Chunked c) d e f (Chunked g) -> ModLeaf a b c d e f g)
<$>datum<*>datum<*>datum<*>datum<*>datum<*>datum<*>datum
instance (Identifier s,Identifier s') => HasIdents s s' (ModLeaf s a) (ModLeaf s' a) where
......@@ -154,10 +155,10 @@ instance Semigroup SourceRange where
NoRange + a = a
a + NoRange = a
instance Monoid SourceRange where zero = NoRange
instance Serializable SourceRange where
encode (SourceRange _ b c) = encodeAlt 0 (b,c)
encode NoRange = encodeAlt 1 ()
instance Format SourceRange where
instance Serializable Word8 Builder Bytes SourceRange where
encode p (SourceRange _ b c) = encodeAlt p 0 (b,c)
encode p NoRange = encodeAlt p 1 ()
instance Format Word8 Builder Bytes SourceRange where
datum = datumOf [FormatAlt (uncurry $ SourceRange Nothing),FormatAlt (uncurry0 NoRange)]
leafDoc :: Lens' (ModLeaf s a) Documentation
......@@ -209,23 +210,24 @@ instance Monoid Library where
cylMagic :: String
cylMagic = "#!/lib/cyl!# "
newtype ParEncode t = ParEncode t
instance (Ord k,Serializable k, Serializable a) => Serializable (ParEncode (Map k a)) where
encode (ParEncode m) = let l = foldr (\x y -> yb chunkBuilder x`par`x:y) [] [encode x | x <- m^.ascList]
in encode (length l) + fold l
instance (Ord k,Format k,Format a) => Format (ParEncode (Map k a)) where
instance (Ord k,Serializable Word8 Builder Bytes k, Serializable Word8 Builder Bytes a) => Serializable Word8 Builder Bytes (ParEncode (Map k a)) where
encode p (ParEncode m) = let l = foldr (\x y -> yb chunkBuilder x`par`x:y) [] [encode p x | x <- m^.ascList]
in encode p (length l) + fold l
instance (Ord k,Format Word8 Builder Bytes k,Format Word8 Builder Bytes a) => Format Word8 Builder Bytes (ParEncode (Map k a)) where
datum = ParEncode . yb ascList<$>datum
instance Serializable Library where
encode l = foldMap encode cylMagic
+ let (m,(a,b,c,d,e,f,g,h)) = l^.scoped.withStrMap
syn = fromMaybe "" (a^?at "synopsis".t'Just.t'Pure)
in foldMap encode (syn+"\n") + encode (curlyLibVersion,Compressed (m,
Chunked (delete "synopsis" a),
Chunked (map Chunked b),
Chunked c,
d,
Chunked e,
f,g,h))
instance Format Library where
instance Serializable Word8 Builder Bytes Library where
encode p l = foldMap (encode p) cylMagic
+ let (m,(a,b,c,d,e,f,g,h)) = l^.scoped.withStrMap
syn = fromMaybe "" (a^?at "synopsis".t'Just.t'Pure)
in foldMap (encode p) (syn+"\n")
+ encode p (curlyLibVersion,Compressed (m,
Chunked (delete "synopsis" a),
Chunked (map Chunked b),
Chunked c,
d,
Chunked e,
f,g,h))
instance Format Word8 Builder Bytes Library where
datum = do
traverse_ (\c -> datum >>= guard . (c==)) cylMagic
syn <- many' (datum <*= guard . (/='\n')) <* (datum >>= guard . (=='\n'))
......
......@@ -10,19 +10,19 @@ import System.IO (hSetBuffering,BufferMode(..))
type InstanceName = String
type PeerErrorMessage = String
data PeerPacket = DeclareInstance InstanceName (WithResponse (Either PeerErrorMessage PeerPort))
| RedeclareInstance InstanceName PeerPort (WithResponse Bool)
| AskInstance InstanceName (WithResponse (Either PeerErrorMessage PeerPort))
| AskInstances (WithResponse [InstanceName])
data PeerPacket = DeclareInstance InstanceName (Proxy (Either PeerErrorMessage PeerPort))
| RedeclareInstance InstanceName PeerPort (Proxy Bool)
| AskInstance InstanceName (Proxy (Either PeerErrorMessage PeerPort))
| AskInstances (Proxy [InstanceName])
deriving Generic
newtype PeerPort = PeerPort { getPeerPortNumber :: PortNumber }
instance Serializable PeerPort where
encode = encode . c'int . fromIntegral . getPeerPortNumber
instance Format PeerPort where
instance Serializable Word8 Builder Bytes PeerPort where
encode p = encode p . c'int . fromIntegral . getPeerPortNumber
instance Format Word8 Builder Bytes PeerPort where
datum = PeerPort . fromIntegral . c'int <$> datum
instance Serializable PeerPacket
instance Format PeerPacket
instance Serializable Word8 Builder Bytes PeerPacket
instance Format Word8 Builder Bytes PeerPacket
processInstances :: IORef (Set InstanceName)
processInstances = newIORef zero^.thunk
......
{-# LANGUAGE GADTs, DeriveGeneric #-}
{-# LANGUAGE GADTs, DeriveGeneric, UndecidableInstances #-}
module Curly.Core.Security(
-- * Keys and Secrets
Access(..),PrivateKey,PublicKey,SharedSecret,KeyFingerprint,Signature,Signed,
......@@ -32,7 +32,7 @@ newtype PublicKey = PublicKey (Integer,Integer)
deriving (Show,Eq)
data Signature = Signature Integer Integer
deriving (Eq,Ord,Generic,Show)
instance Serializable Signature ; instance Format Signature
instance Serializable Word8 Builder Bytes Signature ; instance Format Word8 Builder Bytes Signature
newtype KeyFingerprint = KeyFingerprint Chunk
deriving (Eq,Ord)
......@@ -50,8 +50,8 @@ instance Read Access where
,("admin",Admin),("almighty",Almighty)]]
instance Semigroup Access where (+) = max
instance Monoid Access where zero = minBound
instance Serializable Access where encode a = encode (fromEnum a)
instance Format Access where datum = toEnum <$> datum
instance Serializable Word8 Builder Bytes Access where encode p a = encode p (fromEnum a)
instance Format Word8 Builder Bytes Access where datum = toEnum <$> datum
-- | This function is useless, but it makes textual representations of data look more
-- "random".
......@@ -77,9 +77,9 @@ zest bs = pack $ zipWith xor (unpack bs) zestBytes
]
newtype Zesty a = Zesty a
instance Serializable a => Show (Zesty a) where
instance Serializable Word8 Builder Bytes a => Show (Zesty a) where
show (Zesty a) = show (B64Chunk (zest (serialize a)^.chunk))
instance Format a => Read (Zesty a) where
instance Format Word8 Builder Bytes a => Read (Zesty a) where
readsPrec _ = readsParser ((readable <&> \(B64Chunk c) -> zest (c^..chunk)) >*> (Zesty<$>datum))
fpSize :: Int
......@@ -90,12 +90,12 @@ instance Bounded KeyFingerprint where
minBound = KeyFingerprint (pack [0 :: Word8 | _ <- [1..fpSize]])
maxBound = KeyFingerprint (pack [0xff :: Word8 | _ <- [1..fpSize]])
instance Serializable PrivateKey where encode = coerceEncode PrivateKey
instance Format PrivateKey where datum = coerceDatum PrivateKey
instance Serializable PublicKey where encode = coerceEncode PublicKey
instance Format PublicKey where datum = coerceDatum PublicKey
instance Serializable KeyFingerprint where encode (KeyFingerprint f) = f^.chunkBuilder
instance Format KeyFingerprint where datum = KeyFingerprint<$>getChunk fpSize
instance Serializable Word8 Builder Bytes PrivateKey where encode = coerceEncode PrivateKey
instance Format Word8 Builder Bytes PrivateKey where datum = coerceDatum PrivateKey
instance Serializable Word8 Builder Bytes PublicKey where encode = coerceEncode PublicKey
instance Format Word8 Builder Bytes PublicKey where datum = coerceDatum PublicKey
instance Serializable Word8 Builder Bytes KeyFingerprint where encode _ (KeyFingerprint f) = f^.chunkBuilder
instance Format Word8 Builder Bytes KeyFingerprint where datum = KeyFingerprint<$>getChunk fpSize
chunkToInteger :: Chunk -> Integer
chunkToInteger c = fromMaybe 0 $ matches Just datum
......@@ -137,18 +137,18 @@ bezout a b = (v',u'-(k*v'),g)
data Signed a = Signed a Signature
deriving (Eq,Ord,Show,Generic)
instance Serializable a => Serializable (Signed a)
instance Format a => Format (Signed a)
instance Serializable Word8 Builder Bytes a => Serializable Word8 Builder Bytes (Signed a)
instance Format Word8 Builder Bytes a => Format Word8 Builder Bytes (Signed a)
unsafeExtractSigned :: Signed a -> a
unsafeExtractSigned (Signed a _) = a
extractSignedBy :: Serializable a => PublicKey -> Signed a -> Maybe a
extractSignedBy :: Serializable Word8 Builder Bytes a => PublicKey -> Signed a -> Maybe a
extractSignedBy pub (Signed a s) | isValidSignatureFrom pub s (serialize a) = Just a
| otherwise = Nothing
signValue :: (MonadIO m,Serializable a) => PrivateKey -> a -> m (Signed a)
signValue :: (MonadIO m,Serializable Word8 Builder Bytes a) => PrivateKey -> a -> m (Signed a)
signValue priv a = Signed a <$> signBytes priv (serialize a)
signedDatum :: Format a => PublicKey -> Parser Bytes (Signed a)
signedDatum :: Format Word8 Builder Bytes a => PublicKey -> Parser Bytes (Signed a)
signedDatum pub = datum >>= maybe zero return . extractSignedBy pub
timingRef :: IORef Seconds
......@@ -158,7 +158,7 @@ publicKey :: PrivateKey -> PublicKey
publicKey (PrivateKey n) = thunk $^ do
let ret = EC.pmul EC.basePoint n
start <- currentTime
serialize ret `deepseq` unit
(serialize ret :: Bytes) `deepseq` unit
end <- currentTime
let time = end - start
-- This function pads the key computing time to the maximum observed
......@@ -189,11 +189,11 @@ sharedSecret isClient (PrivateKey priv) (PublicKey pub) = liftIO $ do
logLine Debug $ format "Shared secret : %s" (show (B64Chunk kh))
SharedSecret <$> mkCtx isClient AES.Decrypt <*> mkCtx (not isClient) AES.Encrypt
decrypt :: (MonadIO m,Format a, ?secret :: SharedSecret) => ParserT Bytes m a
decrypt :: (MonadIO m,Format Word8 Builder Bytes a, ?secret :: SharedSecret) => ParserT Bytes m a
decrypt = receive >*> do
remaining >>= liftIO . AES.crypt (readCxt ?secret) . by chunk >>= runStreamState . put . yb chunk
receive
encrypt :: (MonadIO m,Serializable a,?secret :: SharedSecret) => a -> m Bytes
encrypt :: (MonadIO m,Serializable Word8 Builder Bytes a,?secret :: SharedSecret) => a -> m Bytes
encrypt a = liftIO $ yb chunk <$> AES.crypt (writeCxt ?secret) (serialize a ^. chunk)
type KeyStore = Map String (KeyFingerprint,PublicKey,Maybe PrivateKey,Metadata,Map String Access)
......
......@@ -44,8 +44,8 @@ instance HasIdents s s' (TypeClass s) (TypeClass s') where
ff'idents k (NamedType n s) = NamedType n<$>k s
ff'idents k (ClassType n is s) = ClassType n is<$>k s
instance NFData s => NFData (TypeClass s)
instance Serializable s => Serializable (TypeClass s)
instance Format s => Format (TypeClass s)
instance Serializable Word8 Builder Bytes s => Serializable Word8 Builder Bytes (TypeClass s)
instance Format Word8 Builder Bytes s => Format Word8 Builder Bytes (TypeClass s)
typeClassNArgs :: TypeClass s -> Int
typeClassNArgs Function = 2
......@@ -60,8 +60,8 @@ instance Show NativeType where
show NT_Unit = "#unit" ; show NT_File = "#file"
show NT_Syntax = "#syn" ; show NT_Expr = "#expr"
show NT_Array = "#array"
instance Serializable NativeType
instance Format NativeType
instance Serializable Word8 Builder Bytes NativeType
instance Format Word8 Builder Bytes NativeType
instance NFData NativeType
-- | An index into a type
......@@ -71,8 +71,8 @@ instance Identifier s => Show (TypeIndex s) where
show (TypeIndex c n) = show c+":"+show n
instance HasIdents s s' (TypeIndex s) (TypeIndex s') where
ff'idents k (TypeIndex c i) = forl ff'idents c k <&> \c' -> TypeIndex c' i
instance Serializable s => Serializable (TypeIndex s)
instance Format s => Format (TypeIndex s)
instance Serializable Word8 Builder Bytes s => Serializable Word8 Builder Bytes (TypeIndex s)
instance Format Word8 Builder Bytes s => Format Word8 Builder Bytes (TypeIndex s)
instance NFData s => NFData (TypeIndex s)
pattern In :: TypeIndex t
pattern In = TypeIndex Function 0
......@@ -92,8 +92,8 @@ t'ImplicitRoot _ x = pure x
t'ContextRoot :: Traversal' PathRoot Int
t'ContextRoot k (ContextRoot n) = ContextRoot<$>k n
t'ContextRoot _ x = pure x
instance Serializable PathRoot
instance Format PathRoot
instance Serializable Word8 Builder Bytes PathRoot
instance Format Word8 Builder Bytes PathRoot
instance NFData PathRoot
type TypePath s = (PathRoot,[TypeIndex s])
pathIdents :: FixFold s s' (TypePath s) (TypePath s')
......@@ -122,16 +122,16 @@ instance Ord s' => HasIdents s s' (TypeShape s) (TypeShape s') where
ff'idents _ PolyType = pure PolyType
ff'idents _ (SkolemType x) = pure (SkolemType x)
ff'idents _ HiddenTypeError = pure HiddenTypeError
instance Serializable s => Serializable (TypeShape s) where
encode (TypeCons Function) = encodeAlt 0 ()
encode (TypeCons (NamedType n s)) = encodeAlt 1 (n,s)
encode (TypeCons (ClassType n is s)) = encodeAlt 2 (n,is,s)
encode (NativeType t) = encodeAlt 3 t
encode PolyType = encodeAlt 4 ()
encode (SkolemType x) = encodeAlt 5 x
encode (TypeMismatch t t') = encodeAlt 6 (t,t')
encode HiddenTypeError = encodeAlt 7 ()
instance (Format s,Ord s) => Format (TypeShape s) where
instance Serializable Word8 Builder Bytes s => Serializable Word8 Builder Bytes (TypeShape s) where
encode p (TypeCons Function) = encodeAlt p 0 ()
encode p (TypeCons (NamedType n s)) = encodeAlt p 1 (n,s)
encode p (TypeCons (ClassType n is s)) = encodeAlt p 2 (n,is,s)
encode p (NativeType t) = encodeAlt p 3 t
encode p PolyType = encodeAlt p 4 ()
encode p (SkolemType x) = encodeAlt p 5 x
encode p (TypeMismatch t t') = encodeAlt p 6 (t,t')
encode p HiddenTypeError = encodeAlt p 7 ()
instance (Format Word8 Builder Bytes s,Ord s) => Format Word8 Builder Bytes (TypeShape s) where
datum = datumOf [FormatAlt (uncurry0 $ TypeCons Function)
,FormatAlt (\(n,s) -> TypeCons (NamedType n s))
,FormatAlt (\(n,is,s) -> TypeCons (ClassType n is s))
......@@ -156,8 +156,8 @@ unifying constraints on the appropriate types.
-}
newtype Type s = Type (Equiv (TypeShape s) (TypePath s))
deriving Generic
instance (Ord s,Serializable s) => Serializable (Type s)
instance (Ord s,Format s) => Format (Type s)
instance (Ord s,Serializable Word8 Builder Bytes s) => Serializable Word8 Builder Bytes (Type s)
instance (Ord s,Format Word8 Builder Bytes s) => Format Word8 Builder Bytes (Type s)
instance NFData s => NFData (Type s)
type TypeRel s = Equiv (TypeShape s) (TypePath s)
i'typeRel :: Iso (TypeRel s) (TypeRel s') (Type s) (Type s')
......@@ -557,8 +557,8 @@ i'InstanceMap = iso InstanceMap (\(InstanceMap m) -> m)
instance Functor (InstanceMap s) where map f (InstanceMap m) = InstanceMap (map2 f m)
instance Foldable (InstanceMap s) where fold (InstanceMap m) = fold (map fold m)
instance Identifier s => Traversable (InstanceMap s) where sequence (InstanceMap m) = InstanceMap <$> traverse sequence m
instance (Identifier s,Serializable s,Serializable a) => Serializable (InstanceMap s a)
instance (Identifier s,Format s,Format a) => Format (InstanceMap s a)
instance (Identifier s,Serializable Word8 Builder Bytes s,Serializable Word8 Builder Bytes a) => Serializable Word8 Builder Bytes (InstanceMap s a)
instance (Identifier s,Format Word8 Builder Bytes s,Format Word8 Builder Bytes a) => Format Word8 Builder Bytes (InstanceMap s a)
instance (Identifier s,Identifier s') => HasIdents s s' (InstanceMap s a) (InstanceMap s' a) where
ff'idents = from i'InstanceMap.i'ascList.each.
(l'1 .+ l'2.i'ascList.each.l'1.ff'idents)
......
......@@ -22,24 +22,24 @@ type Commit = Compressed (Patch LibraryID Metadata,Maybe Hash)
type Branches = Map String ((PublicKey,String):+:Hash)
data StampedBranches = StampedBranches Int Branches
deriving (Show,Generic)
instance Serializable StampedBranches
instance Format StampedBranches where
instance Serializable Word8 Builder Bytes StampedBranches
instance Format Word8 Builder Bytes StampedBranches where
datum = liftA2 StampedBranches (option 0 datum) datum
instance Lens1 Int Int StampedBranches StampedBranches where
l'1 = lens (\(StampedBranches x _) -> x) (\(StampedBranches _ x) y -> StampedBranches y x)
instance Lens2 Branches Branches StampedBranches StampedBranches where
l'2 = lens (\(StampedBranches _ x) -> x) (\(StampedBranches x _) y -> StampedBranches x y)
data VCKey o = LibraryKey LibraryID (WithResponse Bytes)
| AdditionalKey LibraryID String (WithResponse (Signed (String,Bytes)))
| BranchesKey PublicKey (WithResponse (Signed StampedBranches))
| CommitKey Hash (WithResponse Commit)
data VCKey o = LibraryKey LibraryID (Proxy Bytes)
| AdditionalKey LibraryID String (Proxy (Signed (String,Bytes)))
| BranchesKey PublicKey (Proxy (Signed StampedBranches))
| CommitKey Hash (Proxy Commit)
| OtherKey o
deriving (Show,Generic)
instance Serializable o => Serializable (VCKey o)
instance Format o => Format (VCKey o)
instance Serializable o => Eq (VCKey o) where a==b = compare a b==EQ
instance Serializable o => Ord (VCKey o) where compare = comparing serialize
instance Serializable Word8 Builder Bytes o => Serializable Word8 Builder Bytes (VCKey o)
instance Format Word8 Builder Bytes o => Format Word8 Builder Bytes (VCKey o)
instance Serializable Word8 Builder Bytes o => Eq (VCKey o) where a==b = compare a b==EQ
instance Serializable Word8 Builder Bytes o => Ord (VCKey o) where compare = comparing (\x -> serialize x :: Bytes)
instance Functor VCKey where
map f (OtherKey o) = OtherKey (f o)
map _ (LibraryKey a b) = LibraryKey a b
......@@ -48,12 +48,12 @@ instance Functor VCKey where
map _ (BranchesKey a b) = BranchesKey a b