From af9190ee22359d4cf754e79846538868b6cbb02d Mon Sep 17 00:00:00 2001 From: Paul Chiusano Date: Fri, 2 Oct 2020 11:02:24 -0400 Subject: [PATCH] simplify API - not supporting streaming hashing / hmac for now as serializing / decompiling the hash / hmac state is a can of worms --- parser-typechecker/src/Unison/Builtin.hs | 21 ++--- .../src/Unison/Runtime/Builtin.hs | 93 +++++-------------- .../src/Unison/Runtime/Decompile.hs | 26 +----- .../src/Unison/Runtime/Foreign.hs | 13 --- unison-core/src/Unison/Type.hs | 6 -- 5 files changed, 32 insertions(+), 127 deletions(-) diff --git a/parser-typechecker/src/Unison/Builtin.hs b/parser-typechecker/src/Unison/Builtin.hs index bb8086df4..f24606cf8 100644 --- a/parser-typechecker/src/Unison/Builtin.hs +++ b/parser-typechecker/src/Unison/Builtin.hs @@ -162,7 +162,7 @@ builtinTypesSrc = , B' "Socket" CT.Data, Rename' "Socket" "io2.Socket" , B' "ThreadId" CT.Data, Rename' "ThreadId" "io2.ThreadId" , B' "MVar" CT.Data, Rename' "MVar" "io2.MVar" - , B' "crypto.Hash" CT.Data + , B' "crypto.HashAlgorithm" CT.Data ] -- rename these to "builtin" later, when builtin means intrinsic as opposed to @@ -415,24 +415,15 @@ moveUnder prefix bs = bs >>= \(n,ty) -> [B n ty, Rename n (prefix <> "." <> n)] hashBuiltins :: Var v => [BuiltinDSL v] hashBuiltins = - [ B "crypto.Hash.new" $ hashAlgo --> hash - , B "crypto.Hash.add" $ forall1 "a" (\a -> a --> hash --> hash) - , B "crypto.Hash.addBytes" $ bytes --> hash --> hash - , B "crypto.Hash.finish" $ hash --> bytes - , D "crypto.Hash._internal.init" $ hashAlgo --> bytes --> hash - - , B "crypto.Hmac.new" $ hashAlgo --> bytes --> hmac - , B "crypto.Hmac.add" $ forall1 "a" (\a -> a --> hmac --> hmac) - , B "crypto.Hmac.addBytes" $ bytes --> hmac --> hmac - , B "crypto.Hmac.finish" $ hmac --> bytes - , D "crypto.Hmac._internal.init" $ hashAlgo --> bytes --> bytes --> hmac + [ B "crypto.hash" $ forall1 "a" (\a -> hashAlgo --> a --> bytes) + , B "crypto.hashBytes" $ hashAlgo --> bytes --> bytes + , B "crypto.hmac" $ forall1 "a" (\a -> hashAlgo --> bytes --> a --> bytes) + , B "crypto.hmacBytes" $ hashAlgo --> bytes --> bytes --> bytes ] ++ map h [ "Sha3_512", "Sha3_256", "Sha2_512", "Sha2_256", "Blake2b_512", "Blake2b_256", "Blake2s_256" ] where - hash = Type.ref() Type.hasherRef - hmac = Type.ref() Type.hmacRef hashAlgo = Type.ref() Type.hashAlgorithmRef - h name = B ("crypto.Hash."<>name) $ hashAlgo + h name = B ("crypto.HashAlgorithm."<>name) $ hashAlgo ioBuiltins :: Var v => [(Text, Type v)] ioBuiltins = diff --git a/parser-typechecker/src/Unison/Runtime/Builtin.hs b/parser-typechecker/src/Unison/Runtime/Builtin.hs index 457089c19..6f371ced9 100644 --- a/parser-typechecker/src/Unison/Runtime/Builtin.hs +++ b/parser-typechecker/src/Unison/Runtime/Builtin.hs @@ -19,7 +19,6 @@ module Unison.Runtime.Builtin , eitherTag ) where -import Unsafe.Coerce (unsafeCoerce) import Control.Exception (IOException, try) import Control.Monad.State.Strict (State, modify, execState) import Control.Monad (void) @@ -32,7 +31,7 @@ import Unison.Symbol import Unison.Runtime.Stack (Closure) import Unison.Runtime.Foreign.Function import Unison.Runtime.IOSource -import Unison.Runtime.Foreign (Hasher(..), Hmacinator(..), HashAlgorithm(..)) +import Unison.Runtime.Foreign (HashAlgorithm(..)) import qualified Unison.Type as Ty import qualified Unison.Builtin as Ty (builtinTypes) @@ -1147,6 +1146,7 @@ pfop0 :: ForeignOp pfop0 instr = ([],) $ TFOp instr [] -- Pure ForeignOp taking 1 boxed value +{- pfopb :: ForeignOp pfopb instr = ([BX],) @@ -1154,6 +1154,7 @@ pfopb instr $ TFOp instr [b] where [b] = freshes 1 +-} builtinLookup :: Var v => Map.Map Reference (SuperNormal v) builtinLookup @@ -1440,78 +1441,34 @@ declareForeigns = do . mkForeign $ \(mv :: MVar Closure) -> tryReadMVar mv -- Hashing functions - let hasher :: forall v alg . Var v => Hash.HashAlgorithm alg => Text -> alg -> FDecl v () - hasher txt alg = do - let algoRef = Builtin ("crypto.Hash." <> txt) + let declareHashAlgorithm :: forall v alg . Var v => Hash.HashAlgorithm alg => Text -> alg -> FDecl v () + declareHashAlgorithm txt alg = do + let algoRef = Builtin ("crypto.HashAlgorithm." <> txt) declareForeign ("crypto.Hash." <> txt) pfop0 . mkForeign $ \() -> pure (HashAlgorithm algoRef alg) - hasher "Sha3_512" Hash.SHA3_512 - hasher "Sha3_256" Hash.SHA3_256 - hasher "Sha2_512" Hash.SHA512 - hasher "Sha2_256" Hash.SHA256 - hasher "Blake2b_512" Hash.Blake2b_512 - hasher "Blake2b_256" Hash.Blake2b_256 - hasher "Blake2s_256" Hash.Blake2s_256 + declareHashAlgorithm "Sha3_512" Hash.SHA3_512 + declareHashAlgorithm "Sha3_256" Hash.SHA3_256 + declareHashAlgorithm "Sha2_512" Hash.SHA512 + declareHashAlgorithm "Sha2_256" Hash.SHA256 + declareHashAlgorithm "Blake2b_512" Hash.Blake2b_512 + declareHashAlgorithm "Blake2b_256" Hash.Blake2b_256 + declareHashAlgorithm "Blake2s_256" Hash.Blake2s_256 - declareForeign ("crypto.Hash.new") pfopb . mkForeign $ \(HashAlgorithm ref alg) -> - pure (Hasher ref $ Hash.hashInitWith alg) + declareForeign ("crypto.hash") pfopbb . mkForeign $ \(HashAlgorithm _ref _alg, _a :: Closure) -> + pure $ Bytes.empty -- todo : implement me - declareForeign "crypto.Hash.addBytes" pfopbb . mkForeign $ - \(b :: Bytes.Bytes, Hasher ref ctx) -> - pure (Hasher ref $ Hash.hashUpdates ctx (Bytes.chunks b)) + declareForeign "crypto.hashBytes" pfopbb . mkForeign $ + \(HashAlgorithm _ alg, b :: Bytes.Bytes) -> + let ctx = Hash.hashInitWith alg + in pure . Bytes.fromArray . Hash.hashFinalize $ Hash.hashUpdates ctx (Bytes.chunks b) - -- declareForeign "Hash.add" pfopbb . mkForeign $ - -- \(Hasher ctx, x :: Closure) -> error "todo - Hash.add universal function" - - declareForeign "crypto.Hash.finish" pfopb - . mkForeign $ \(Hasher _ ctx) -> pure (Bytes.fromArray $ Hash.hashFinalize ctx) - - let - -- todo: ensure the given bytes represent valid - -- state for the hashing algorithm, otherwise the C code - -- backing the algorithm's implementation will do who knows what - validateState :: Hash.HashAlgorithm a => a -> Bytes.Bytes -> Bool - validateState _a _bs = True -- - -- toBytes :: Hash.Context a -> BA.Bytes = unsafeCoerce - - declareForeign "crypto.Hash._internal.init" pfopbb . mkForeign $ - \(HashAlgorithm r alg, b :: Bytes.Bytes) -> - let unify :: a -> Hash.Context a -> Hash.Context a - unify _ a = a - in if validateState alg b then - pure . Hasher r . unify alg . unsafeCoerce . Bytes.toArray @BA.Bytes $ b - else - fail $ "invalid argument to crypto.Hash._internal.init " <> show b - - declareForeign "crypto.Hmac.new" pfopbb - . mkForeign $ \(HashAlgorithm r alg, key :: Bytes.Bytes) -> do - let unify :: a -> HMAC.Context a -> HMAC.Context a - unify _ a = a - pure (Hmacinator r (unify alg (HMAC.initialize (Bytes.toArray @BA.Bytes key)))) - - declareForeign "crypto.Hmac.addBytes" pfopbb . mkForeign $ - \(b :: Bytes.Bytes, Hmacinator ref ctx) -> - pure (Hmacinator ref $ HMAC.updates ctx (Bytes.chunks b)) - - declareForeign "crypto.Hmac._internal.init" pfopbbb . mkForeign $ - \(HashAlgorithm ref a, b1 :: Bytes.Bytes, b2 :: Bytes.Bytes) -> do - let hctx b = unify a (cast (Bytes.toArray b)) - unify :: a -> Hash.Context a -> Hash.Context a - unify _ a = a - cast :: BA.Bytes -> Hash.Context x - cast = unsafeCoerce - -- todo: proper validation logic - if validateState a b1 && validateState a b2 then - pure . Hmacinator ref $ HMAC.Context (hctx b1) (hctx b2) - else - fail $ "invalid argument to crypto.Hmac._internal.init " <> show (b1,b2) - - -- declareForeign "crypto.Hmac.add" pfopbb . mkForeign $ - -- \(Hmacinator r ctx, x :: Closure) -> error "todo - Hmac.add universal function" - - declareForeign "crypto.Hmac.finish" pfopb - . mkForeign $ \(Hmacinator _ ctx) -> pure (Bytes.fromArray $ HMAC.finalize ctx) + declareForeign "crypto.hmacBytes" pfopbbb + . mkForeign $ \(HashAlgorithm _ alg, key :: Bytes.Bytes, msg :: Bytes.Bytes) -> + let out = u alg $ HMAC.hmac (Bytes.toArray @BA.Bytes key) (Bytes.toArray @BA.Bytes msg) + u :: a -> HMAC.HMAC a -> HMAC.HMAC a + u _ h = h -- to help typechecker along + in pure $ Bytes.fromArray out hostPreference :: Maybe Text -> SYS.HostPreference hostPreference Nothing = SYS.HostAny diff --git a/parser-typechecker/src/Unison/Runtime/Decompile.hs b/parser-typechecker/src/Unison/Runtime/Decompile.hs index af8b86654..048ddcae4 100644 --- a/parser-typechecker/src/Unison/Runtime/Decompile.hs +++ b/parser-typechecker/src/Unison/Runtime/Decompile.hs @@ -8,7 +8,6 @@ module Unison.Runtime.Decompile import Prelude hiding (seq) import Unison.Prelude -import qualified Data.ByteArray import Unison.ABT (absChain, substs, pattern AbsN') import Unison.Term @@ -24,7 +23,7 @@ import Unison.Reference (Reference) import Unison.Runtime.ANF (RTag, CTag, Tag(..)) import Unison.Runtime.Foreign - (Foreign, Hasher(..), HashAlgorithm(..), Hmacinator(..), maybeUnwrapBuiltin, maybeUnwrapForeign) + (Foreign, HashAlgorithm(..), maybeUnwrapBuiltin, maybeUnwrapForeign) import Unison.Runtime.Stack (Closure(..), pattern DataC, pattern PApV, IComb(..)) @@ -32,7 +31,6 @@ import Unison.Codebase.Runtime (Error) import Unison.Util.Pretty (lit) import qualified Unison.Util.Bytes as By -import qualified Crypto.MAC.HMAC as HMAC import Unsafe.Coerce -- for Int -> Double @@ -107,9 +105,7 @@ decompileForeign decompileForeign tyRef topTerms f | Just t <- maybeUnwrapBuiltin f = Right $ text () t | Just b <- maybeUnwrapBuiltin f = Right $ decompileBytes b - | Just h <- maybeUnwrapBuiltin f = Right $ decompileHasher h | Just h <- maybeUnwrapBuiltin f = Right $ decompileHashAlgorithm h - | Just h <- maybeUnwrapBuiltin f = Right $ decompileHmacinator h | Just s <- unwrapSeq f = seq' () <$> traverse (decompile tyRef topTerms) s decompileForeign _ _ _ = err "cannot decompile Foreign" @@ -122,25 +118,5 @@ decompileBytes decompileHashAlgorithm :: Var v => HashAlgorithm -> Term v () decompileHashAlgorithm (HashAlgorithm r _) = ref () r -decompileHmacinator :: Var v => Hmacinator -> Term v () -decompileHmacinator (Hmacinator r (HMAC.Context a b)) = - apps' (builtin () "crypto.Hmac._internal.init") [ - ref () r, - decompileBytes $ bs a, - decompileBytes $ bs b - ] - where - -- NB: a hashing context is just `newtype Context a = Context Data.ByteArray.Bytes` - -- but cryptonite doesn't expose the constructor sadly - bs ctx = By.fromArray (unsafeCoerce ctx :: Data.ByteArray.Bytes) - -decompileHasher :: Var v => Hasher -> Term v () -decompileHasher (Hasher r ctx) = - apps' (builtin () "crypto.Hash._internal.init") [ref () r, decompileBytes bs] - where - -- NB: a hashing context is just `newtype Context a = Context Data.ByteArray.Bytes` - -- but cryptonite doesn't expose the constructor sadly - bs = By.fromArray (unsafeCoerce ctx :: Data.ByteArray.Bytes) - unwrapSeq :: Foreign -> Maybe (Seq Closure) unwrapSeq = maybeUnwrapForeign vectorRef diff --git a/parser-typechecker/src/Unison/Runtime/Foreign.hs b/parser-typechecker/src/Unison/Runtime/Foreign.hs index 4d92cb953..66ddc7004 100644 --- a/parser-typechecker/src/Unison/Runtime/Foreign.hs +++ b/parser-typechecker/src/Unison/Runtime/Foreign.hs @@ -5,8 +5,6 @@ module Unison.Runtime.Foreign ( Foreign(..) - , Hasher(..) - , Hmacinator(..) , HashAlgorithm(..) , unwrapForeign , maybeUnwrapForeign @@ -26,7 +24,6 @@ import Unison.Reference (Reference) import Unison.Referent (Referent) import qualified Unison.Type as Ty import qualified Crypto.Hash as Hash -import qualified Crypto.MAC.HMAC as HMAC import Unsafe.Coerce data Foreign where @@ -85,17 +82,7 @@ data HashAlgorithm where -- Reference is a reference to the hash algorithm HashAlgorithm :: Hash.HashAlgorithm a => Reference -> a -> HashAlgorithm -data Hasher where - -- Reference is a reference to the hash algorithm - Hasher :: Hash.HashAlgorithm a => Reference -> Hash.Context a -> Hasher - -data Hmacinator where - -- Reference is a reference to the hash algorithm - Hmacinator :: Hash.HashAlgorithm a => Reference -> HMAC.Context a -> Hmacinator - instance BuiltinForeign HashAlgorithm where foreignRef = Tagged Ty.hashAlgorithmRef -instance BuiltinForeign Hasher where foreignRef = Tagged Ty.hasherRef -instance BuiltinForeign Hmacinator where foreignRef = Tagged Ty.hmacRef wrapBuiltin :: forall f. BuiltinForeign f => f -> Foreign wrapBuiltin x = Wrap r x diff --git a/unison-core/src/Unison/Type.hs b/unison-core/src/Unison/Type.hs index 2cc4fa4a0..da494ccd0 100644 --- a/unison-core/src/Unison/Type.hs +++ b/unison-core/src/Unison/Type.hs @@ -229,15 +229,9 @@ socketRef = Reference.Builtin "Socket" mvarRef :: Reference mvarRef = Reference.Builtin "MVar" -hasherRef :: Reference -hasherRef = Reference.Builtin "crypto.Hash" - hashAlgorithmRef :: Reference hashAlgorithmRef = Reference.Builtin "crypto.HashAlgorithm" -hmacRef :: Reference -hmacRef = Reference.Builtin "crypto.Hmac" - builtin :: Ord v => a -> Text -> Type v a builtin a = ref a . Reference.Builtin