├── Setup.hs ├── .gitignore ├── Data ├── Authenticated │ ├── Fix.hs │ ├── Generic.hs │ ├── Example.hs │ └── GenericExample.hs └── Authenticated.hs ├── notes.md ├── ads.cabal ├── LICENSE └── README.md /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist/ 2 | .cabal-sandbox/ 3 | *.hi 4 | *.o 5 | cabal.sandbox.config 6 | -------------------------------------------------------------------------------- /Data/Authenticated/Fix.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE UndecidableInstances #-} 2 | {-# LANGUAGE TypeFamilies #-} 3 | module Data.Authenticated.Fix (FixAuth(..)) where 4 | import Data.Authenticated 5 | 6 | newtype FixAuth f a = FixAuth { unFixAuth :: f (Auth (FixAuth f a) a) } 7 | 8 | instance (Show (f (Auth (FixAuth f a) a))) => Show (FixAuth f a) where 9 | showsPrec n (FixAuth f) = showsPrec n f 10 | 11 | instance (Digest (FixAuth f Prover) ~ Digest (FixAuth f Verifier), Functor f) => MapAuth (FixAuth f) where 12 | mapAuth (FixAuth f) = FixAuth (fmap shallowAuth f) 13 | 14 | -- Requires UndecidableInstances 15 | instance (Authenticated a, Digestible (f (Auth (FixAuth f a) a))) => Digestible (FixAuth f a) where 16 | type Digest (FixAuth f a) = Digest (f (Auth (FixAuth f a) a)) 17 | digest (FixAuth f) = digest f 18 | -------------------------------------------------------------------------------- /notes.md: -------------------------------------------------------------------------------- 1 | * Make AuthM a Pipe or Conduit or at least behave similar to one so proof streams can be sent and received incrementally. 2 | * Implement SYB. 3 | * Implement Template Haskell based derivation of MapAuth. 4 | * Add generic implementation of Digestible. 5 | * Add more examples from paper. 6 | * Make demo client/server executable. 7 | * Optimize AuthM monads 8 | * inline and choose a better Monoid for the Prover (or even better use a Pipe/Conduit based approach) 9 | * inline and switch the StateT Maybe monad to a CPS based version 10 | * Try to make the types a little nicer (i.e. so Show is derivable and FlexibleContexts and UndecidableInstances aren't needed by the user) 11 | * Maybe make AuthM monad transformers. (This is trivial to do, it's just a question on how this impacts the semantics. I don't think it would impact security but I'm not sure about this. It definitely impacts coherence (e.g. the Skip List example from the paper.)) 12 | * Maybe support Cloud Haskell functions... 13 | * Explore accomplishing higher level optimization in a clean manner (or give up and implement the ones from the paper as-is) 14 | -------------------------------------------------------------------------------- /ads.cabal: -------------------------------------------------------------------------------- 1 | name: ads 2 | version: 0.1.0.0 3 | synopsis: An EDSL for making authenticated data structures such as Merkle trees. 4 | description: An embedding of the language described in "Authenticated Data Structures, Generically" by Andrew Miller et al into Haskell. 5 | license: BSD2 6 | license-file: LICENSE 7 | author: Derek Elkins 8 | maintainer: derek.a.elkins@gmail.com 9 | copyright: Copyright (c) 2015 Derek Elkins 10 | category: Data 11 | build-type: Simple 12 | extra-source-files: README.md 13 | cabal-version: >=1.10 14 | 15 | library 16 | exposed-modules: Data.Authenticated, Data.Authenticated.Generic, Data.Authenticated.Fix 17 | other-modules: Data.Authenticated.Example, Data.Authenticated.GenericExample 18 | other-extensions: GeneralizedNewtypeDeriving, FlexibleInstances, FlexibleContexts, EmptyDataDecls, TypeFamilies, UndecidableInstances 19 | build-depends: base >=4.8 && <4.9, mtl >=2.2 && <2.3, bytestring >=0.10 && <0.11, cryptonite(==0.5) 20 | -- hs-source-dirs: 21 | default-language: Haskell2010 22 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, Derek Elkins 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are 6 | met: 7 | 8 | 1. Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | 2. Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the 14 | distribution. 15 | 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 17 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 18 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 19 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 20 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 21 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 22 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 26 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | -------------------------------------------------------------------------------- /Data/Authenticated/Generic.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE UndecidableInstances #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE TypeOperators #-} 4 | {-# LANGUAGE TypeFamilies #-} 5 | module Data.Authenticated.Generic (Auth1(..)) where 6 | import Data.Authenticated 7 | import GHC.Generics 8 | 9 | newtype Auth1 f a = Auth1 { getAuth1 :: Auth (f a) a } 10 | -- These two instances are what requires UndecidableInstances. 11 | instance (Show (f Prover), Show (Digest (f Prover))) => Show (Auth1 f Prover) where 12 | showsPrec n = showsPrec n . getAuth1 13 | instance (Show (f Verifier), Show (Digest (f Verifier))) => Show (Auth1 f Verifier) where 14 | showsPrec n = showsPrec n . getAuth1 15 | 16 | instance GMapAuth V1 where 17 | gmapAuth = undefined 18 | 19 | instance GMapAuth U1 where 20 | gmapAuth U1 = U1 21 | 22 | instance (GMapAuth l, GMapAuth r) => GMapAuth (l :+: r) where 23 | gmapAuth (L1 x) = L1 (gmapAuth x) 24 | gmapAuth (R1 x) = R1 (gmapAuth x) 25 | 26 | instance (GMapAuth l, GMapAuth r) => GMapAuth (l :*: r) where 27 | gmapAuth (x :*: y) = gmapAuth x :*: gmapAuth y 28 | 29 | instance GMapAuth (K1 i c) where 30 | gmapAuth (K1 c) = K1 c 31 | 32 | instance (GMapAuth f) => GMapAuth (M1 i t f) where 33 | gmapAuth (M1 x) = M1 (gmapAuth x) 34 | 35 | instance (MapAuth f) => GMapAuth (Rec1 f) where 36 | gmapAuth (Rec1 x) = Rec1 (mapAuth x) 37 | 38 | -- instance GMapAuth Par1 - This should never happen for correct data types (i.e. whose parameter is Authenticated) 39 | 40 | instance (Digest (f Prover) ~ Digest (f Verifier)) => MapAuth (Auth1 f) where 41 | mapAuth (Auth1 x) = Auth1 (shallowAuth x) 42 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Authenticated Data Structures 2 | ============================= 3 | 4 | What it is 5 | ---------- 6 | 7 | This is an embedding into Haskell of the language described in 8 | [Authenticated Data Structures, Generically](http://www.cs.umd.edu/~amiller/gpads/). An example use-case would be implementing 9 | a Merkle tree. It doesn't (currently) implement any of the optimizations described in the paper and, like the implementation 10 | described in the paper, does not support authenticated functions. 11 | 12 | There are three methods for making an authenticated data with this library. You can manually add `Auth` data types to your 13 | structure and manually implement `MapAuth`. You can represent your data structure as a fix point using `FixAuth` and it 14 | will automatically be an instance of `MapAuth` as in [this example](https://github.com/derekelkins/ads/blob/master/Data/Authenticated/Example.hs). 15 | You can use `Auth1` data types and use derive `Generics1` and then simply state `instance MapAuth YourDataType` 16 | (see [GHC Generics](https://hackage.haskell.org/package/base-4.8.0.0/docs/GHC-Generics.html) 17 | and [this example](https://github.com/derekelkins/ads/blob/master/Data/Authenticated/GenericExample.hs)). 18 | 19 | All methods require implementing `Digestible` which should calculate a cryptographic digest of the data structure. 20 | 21 | Operations over your data structure will be in the `AuthM` monad and the `Auth` data structure is introduced and eliminated 22 | with `auth` and `unauth` respectively. (`Auth1` is just a wrapper around `Auth`.) The `AuthM` monad is parameterized by the 23 | mode, `Prover` or `Verifier`, the type of the proof stream, and the return type of the monadic action. Calling `runProver` on 24 | an `AuthM` computation will return a pair containing the computations return value and the proof stream. Typically, you would 25 | serialize the proof stream and send it to a client on whose behalf you are doing the work. The client would then call 26 | `runVerifier` on the same computation which results in a function which takes a proof stream and returns `Maybe` the result 27 | depending on whether the verification succeeds or not. 28 | 29 | The representation of `Auth` (and thus data structures built on it) varies depending on the mode. Typically, the client (verifier) 30 | will have a top-level digest from a trusted source (this is what your data type will look like in Verifier mode) and will receive 31 | a proof stream from an untrusted server (prover) claiming to have performed the operation on the client's behalf. The proof stream 32 | will typically be tantamount to a stream of hashes which the client will use to verify the integrity of the computation. 33 | 34 | As a concrete example, if a client wants to request a value from an untrusted server mirroring a large Merkle tree, then the client 35 | can do that and verify correctness without needing, itself, to store all of the Merkle tree. All the client would need is the 36 | top-level hash of the Merkle tree from a trusted source, and the stream of hashes from the untrusted mirror which will be 37 | logarithmic in the size of the Merkle tree. 38 | -------------------------------------------------------------------------------- /Data/Authenticated/Example.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE TypeFamilies #-} 3 | {-# LANGUAGE DeriveFunctor #-} 4 | module Data.Authenticated.Example where 5 | import qualified Crypto.Hash as Crypto 6 | import Data.Authenticated 7 | import Data.Authenticated.Fix 8 | import qualified Data.ByteString as BS 9 | import qualified Data.ByteString.Char8 as CBS 10 | 11 | -- Over-simplified Merkle Tree 12 | data Bit = L | R 13 | data Tree' x = Tip String | Bin x x 14 | deriving (Show, Functor) 15 | 16 | type Tree = FixAuth Tree' 17 | type AuthTree a = Auth (Tree a) a 18 | 19 | bin :: (Authenticated a) => AuthTree a -> AuthTree a -> AuthTree a 20 | bin l r = auth (FixAuth (Bin l r)) 21 | 22 | tip :: (Authenticated a) => String -> AuthTree a 23 | tip s = auth (FixAuth (Tip s)) 24 | 25 | type TreeDigest = Crypto.Digest Crypto.SHA256 26 | 27 | instance (Digestible t, Digest t ~ TreeDigest) => Digestible (Tree' t) where 28 | type Digest (Tree' a) = TreeDigest 29 | digest (Tip s) = Crypto.hash (CBS.pack s) 30 | digest (Bin l r) = Crypto.hashFinalize (Crypto.hashUpdate (Crypto.hashUpdate Crypto.hashInit (digest l)) (digest r)) 31 | 32 | -- For simplicity, assumes a complete tree. 33 | fetch :: (Authenticated a, Monad (AuthM a (Tree a))) => [Bit] -> AuthTree a -> AuthM a (Tree a) String 34 | fetch ix t = do 35 | t' <- fmap unFixAuth (unauth t) 36 | case (ix, t') of 37 | ([] , Tip s ) -> return s 38 | (L:ix', Bin l _) -> fetch ix' l 39 | (R:ix', Bin _ r) -> fetch ix' r 40 | 41 | update :: (Authenticated a, Monad (AuthM a (Tree a))) => [Bit] -> AuthTree a -> String -> AuthM a (Tree a) (AuthTree a) 42 | update ix t s' = do 43 | t' <- fmap unFixAuth (unauth t) 44 | case (ix, t') of 45 | ([] , Tip s ) -> return (tip s') 46 | (L:ix', Bin l r) -> do 47 | l' <- update ix' l s' 48 | return (bin l' r) 49 | (R:ix', Bin l r) -> do 50 | r' <- update ix' r s' 51 | return (bin l r') 52 | 53 | exampleTree :: (Authenticated a) => AuthTree a 54 | exampleTree = bin (bin (tip "ll") (tip "lr")) (bin (tip "rl") (tip "rr")) 55 | 56 | -- Realistically, the verifier would run on a client who would fetch exampleTree :: Auth (Tree 'Verifier) 'Verifier, 57 | -- which is just a single hash from a trusted source. The (untrusted) prover would run on a server and return a [Tree 'Verifier] 58 | -- which is a list of shallow trees (i.e. a list of hashes terminating in a Tip which holds the result in this case). The client 59 | -- would run the verifier and, if successful, get back a verified result. 60 | 61 | works :: Maybe String 62 | works = runVerifier (fetch [R,L] exampleTree) ps' -- Note, exampleTree here is just a top-level digest. 63 | where (_, ps) = runProver (fetch [R,L] exampleTree) -- exampleTree here is the full tree. 64 | ps' = map mapAuth ps -- Note, this is just a list of hashes plus a Tip at the end. 65 | 66 | doesn'tWork :: Maybe String 67 | doesn'tWork = runVerifier (fetch [R,R] exampleTree) ps' -- Note, exampleTree here is just a top-level digest. 68 | where (_, ps) = runProver (fetch [R,L] exampleTree) -- exampleTree here is the full tree. 69 | ps' = map mapAuth ps -- Note, this is just a list of hashes plus a Tip at the end. 70 | 71 | -- Red-Black+ Tree 72 | data Color = Red | Black deriving (Show) 73 | data RB a = RBTip | RBBin !Color (Auth (RB a) a) !Int (Maybe String) (Auth (RB a) a) 74 | -------------------------------------------------------------------------------- /Data/Authenticated/GenericExample.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE UndecidableInstances #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE ViewPatterns #-} 4 | {-# LANGUAGE TypeFamilies #-} 5 | {-# LANGUAGE FlexibleContexts #-} 6 | module Data.Authenticated.GenericExample where 7 | import qualified Crypto.Hash as Crypto 8 | import Data.Authenticated 9 | import Data.Authenticated.Generic 10 | import qualified Data.ByteString as BS 11 | import qualified Data.ByteString.Char8 as CBS 12 | import GHC.Generics (Generic1) 13 | 14 | {- 15 | D1 D1Tree 16 | (C1 C1_0Tree (S1 NoSelector (Rec0 String)) 17 | :+: C1 C1_1Tree 18 | (S1 NoSelector (Rec1 (Auth1 Tree)) 19 | :*: S1 NoSelector (Rec1 (Auth1 Tree)))) 20 | -} 21 | 22 | data Bit = L | R 23 | data Tree a = Tip String | Bin (AuthTree a) (AuthTree a) 24 | deriving (Generic1) 25 | type AuthTree = Auth1 Tree 26 | 27 | bin :: (Authenticated a) => AuthTree a -> AuthTree a -> AuthTree a 28 | bin l r = Auth1 (auth (Bin l r)) 29 | 30 | tip :: (Authenticated a) => String -> AuthTree a 31 | tip s = Auth1 (auth (Tip s)) 32 | 33 | -- Requires UndecidableInstances 34 | instance (Digestible (Auth (Tree a) a)) => Digestible (Tree a) where 35 | type Digest (Tree a) = Crypto.Digest Crypto.SHA256 36 | digest (Tip s) = Crypto.hash (CBS.pack s) 37 | digest (Bin (getAuth1 -> l) (getAuth1 -> r)) = Crypto.hashFinalize (Crypto.hashUpdate (Crypto.hashUpdate Crypto.hashInit (digest l)) (digest r)) 38 | 39 | instance MapAuth Tree 40 | 41 | -- For simplicity, assumes a complete tree. 42 | fetch :: (Authenticated a, Monad (AuthM a (Tree a))) => [Bit] -> AuthTree a -> AuthM a (Tree a) String 43 | fetch ix t = do 44 | t' <- unauth (getAuth1 t) 45 | case (ix, t') of 46 | ([] , Tip s ) -> return s 47 | (L:ix', Bin l _) -> fetch ix' l 48 | (R:ix', Bin _ r) -> fetch ix' r 49 | 50 | update :: (Authenticated a, Monad (AuthM a (Tree a))) => [Bit] -> AuthTree a -> String -> AuthM a (Tree a) (AuthTree a) 51 | update ix t s' = do 52 | t' <- unauth (getAuth1 t) 53 | case (ix, t') of 54 | ([] , Tip s ) -> return (tip s') 55 | (L:ix', Bin l r) -> do 56 | l' <- update ix' l s' 57 | return (bin l' r) 58 | (R:ix', Bin l r) -> do 59 | r' <- update ix' r s' 60 | return (bin l r') 61 | 62 | exampleTree :: (Authenticated a) => AuthTree a 63 | exampleTree = bin (bin (tip "ll") (tip "lr")) (bin (tip "rl") (tip "rr")) 64 | 65 | -- Realistically, the verifier would run on a client who would fetch exampleTree :: Auth (Tree 'Verifier) 'Verifier, 66 | -- which is just a single hash from a trusted source. The (untrusted) prover would run on a server and return a [Tree 'Verifier] 67 | -- which is a list of shallow trees (i.e. a list of hashes terminating in a Tip which holds the result in this case). The client 68 | -- would run the verifier and, if successful, get back a verified result. 69 | 70 | works :: Maybe String 71 | works = runVerifier (fetch [R,L] exampleTree) ps' -- Note, exampleTree here is just a top-level digest. 72 | where (_, ps) = runProver (fetch [R,L] exampleTree) -- exampleTree here is the full tree. 73 | ps' = map mapAuth ps -- Note, this is just a list of hashes plus a Tip at the end. 74 | 75 | doesn'tWork :: Maybe String 76 | doesn'tWork = runVerifier (fetch [R,R] exampleTree) ps' -- Note, exampleTree here is just a top-level digest. 77 | where (_, ps) = runProver (fetch [R,L] exampleTree) -- exampleTree here is the full tree. 78 | ps' = map mapAuth ps -- Note, this is just a list of hashes plus a Tip at the end. 79 | -------------------------------------------------------------------------------- /Data/Authenticated.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDecls #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE TypeFamilies #-} 6 | {-# LANGUAGE DefaultSignatures #-} 7 | module Data.Authenticated (Prover, Verifier, AuthM, Auth, runProver, runVerifier, Digestible(..), Authenticated(..), GMapAuth(..), MapAuth(..), shallowAuth) where 8 | -- Implements the ideas from "Authenticated Data Structures, Generically" by Andrew Miller, Michael Hicks, Jonathan Katz, and Elaine Shi. 9 | import Control.Monad.State 10 | import Control.Monad.Writer 11 | import GHC.Generics (Generic1, to1, from1, Rep1) 12 | 13 | data Prover 14 | data Verifier 15 | 16 | class GMapAuth f where 17 | gmapAuth :: f Prover -> f Verifier 18 | 19 | -- Abstract 20 | data family AuthM a s t 21 | -- TODO: Use a better Monoid. 22 | newtype instance AuthM Prover s t = Output { runOutput :: Writer [s] t } 23 | deriving (Functor, Applicative, Monad, MonadWriter [s]) 24 | newtype instance AuthM Verifier s t = Input { runInput :: StateT [s] Maybe t } 25 | deriving (Functor, Applicative, Monad, MonadState [s]) 26 | 27 | -- Abstract 28 | data family Auth t a 29 | data instance Auth t Prover = WithDigest !t !(Digest t) 30 | newtype instance Auth t Verifier = OnlyDigest (Digest t) 31 | 32 | instance (Show t, Show (Digest t)) => Show (Auth t Prover) where 33 | showsPrec n (WithDigest t d) = showParen (n > 0) $ ("WithDigest "++) . showsPrec 11 t . (' ':) . showsPrec 11 d 34 | 35 | instance (Show (Digest t)) => Show (Auth t Verifier) where 36 | showsPrec n (OnlyDigest d) = showParen (n > 0) $ ("OnlyDigest "++) . showsPrec 11 d 37 | 38 | class (Eq (Digest t)) => Digestible t where 39 | type Digest t :: * 40 | digest :: t -> Digest t 41 | 42 | -- Is this instance right? 43 | instance (Eq (Digest t), Authenticated a) => Digestible (Auth t a) where 44 | type Digest (Auth t a) = Digest t 45 | digest a = getDigest a 46 | 47 | class Authenticated a where 48 | type AuthResult a s t :: * 49 | auth :: Digestible t => t -> Auth t a 50 | unauth :: Digestible t => Auth t a -> AuthM a t t 51 | getDigest :: Auth t a -> Digest t 52 | runAuthM :: AuthM a s t -> AuthResult a s t 53 | 54 | instance Authenticated Prover where 55 | type AuthResult Prover s t = (t, [s]) 56 | auth t = WithDigest t (digest t) 57 | unauth (WithDigest t _) = tell [t] >> return t 58 | getDigest (WithDigest _ d) = d 59 | runAuthM (Output m) = runWriter m 60 | 61 | instance Authenticated Verifier where 62 | type AuthResult Verifier s t = [s] -> Maybe t 63 | auth t = OnlyDigest (digest t) 64 | unauth (OnlyDigest d) = do 65 | ts <- get 66 | case ts of 67 | [] -> fail "Unexpected end of proof stream" 68 | (t:ts') -> do 69 | put ts' 70 | if digest t == d then return t else fail "Digest verification failed" 71 | getDigest (OnlyDigest d) = d 72 | runAuthM (Input m) = fmap fst . runStateT m 73 | 74 | runProver :: AuthM Prover s t -> AuthResult Prover s t 75 | runProver = runAuthM 76 | 77 | runVerifier :: AuthM Verifier s t -> AuthResult Verifier s t 78 | runVerifier = runAuthM 79 | 80 | class MapAuth f where 81 | mapAuth :: f Prover -> f Verifier 82 | default mapAuth :: (GMapAuth (Rep1 f), Generic1 f) => f Prover -> f Verifier 83 | mapAuth = to1 . gmapAuth . from1 84 | 85 | instance MapAuth (Auth t) where 86 | mapAuth = shallowAuth 87 | 88 | shallowAuth :: (Digest s ~ Digest t) => Auth s Prover -> Auth t Verifier 89 | shallowAuth (WithDigest _ d) = OnlyDigest d 90 | --------------------------------------------------------------------------------