simplify API - not supporting streaming hashing / hmac for now as serializing / decompiling the hash / hmac state is a can of worms

This commit is contained in:
Paul Chiusano 2020-10-02 11:02:24 -04:00
parent f17fafb27f
commit af9190ee22
5 changed files with 32 additions and 127 deletions

View File

@ -162,7 +162,7 @@ builtinTypesSrc =
, B' "Socket" CT.Data, Rename' "Socket" "io2.Socket" , B' "Socket" CT.Data, Rename' "Socket" "io2.Socket"
, B' "ThreadId" CT.Data, Rename' "ThreadId" "io2.ThreadId" , B' "ThreadId" CT.Data, Rename' "ThreadId" "io2.ThreadId"
, B' "MVar" CT.Data, Rename' "MVar" "io2.MVar" , 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 -- 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 :: Var v => [BuiltinDSL v]
hashBuiltins = hashBuiltins =
[ B "crypto.Hash.new" $ hashAlgo --> hash [ B "crypto.hash" $ forall1 "a" (\a -> hashAlgo --> a --> bytes)
, B "crypto.Hash.add" $ forall1 "a" (\a -> a --> hash --> hash) , B "crypto.hashBytes" $ hashAlgo --> bytes --> bytes
, B "crypto.Hash.addBytes" $ bytes --> hash --> hash , B "crypto.hmac" $ forall1 "a" (\a -> hashAlgo --> bytes --> a --> bytes)
, B "crypto.Hash.finish" $ hash --> bytes , B "crypto.hmacBytes" $ hashAlgo --> bytes --> bytes --> 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
] ++ ] ++
map h [ "Sha3_512", "Sha3_256", "Sha2_512", "Sha2_256", "Blake2b_512", "Blake2b_256", "Blake2s_256" ] map h [ "Sha3_512", "Sha3_256", "Sha2_512", "Sha2_256", "Blake2b_512", "Blake2b_256", "Blake2s_256" ]
where where
hash = Type.ref() Type.hasherRef
hmac = Type.ref() Type.hmacRef
hashAlgo = Type.ref() Type.hashAlgorithmRef 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 :: Var v => [(Text, Type v)]
ioBuiltins = ioBuiltins =

View File

@ -19,7 +19,6 @@ module Unison.Runtime.Builtin
, eitherTag , eitherTag
) where ) where
import Unsafe.Coerce (unsafeCoerce)
import Control.Exception (IOException, try) import Control.Exception (IOException, try)
import Control.Monad.State.Strict (State, modify, execState) import Control.Monad.State.Strict (State, modify, execState)
import Control.Monad (void) import Control.Monad (void)
@ -32,7 +31,7 @@ import Unison.Symbol
import Unison.Runtime.Stack (Closure) import Unison.Runtime.Stack (Closure)
import Unison.Runtime.Foreign.Function import Unison.Runtime.Foreign.Function
import Unison.Runtime.IOSource 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.Type as Ty
import qualified Unison.Builtin as Ty (builtinTypes) import qualified Unison.Builtin as Ty (builtinTypes)
@ -1147,6 +1146,7 @@ pfop0 :: ForeignOp
pfop0 instr = ([],) $ TFOp instr [] pfop0 instr = ([],) $ TFOp instr []
-- Pure ForeignOp taking 1 boxed value -- Pure ForeignOp taking 1 boxed value
{-
pfopb :: ForeignOp pfopb :: ForeignOp
pfopb instr pfopb instr
= ([BX],) = ([BX],)
@ -1154,6 +1154,7 @@ pfopb instr
$ TFOp instr [b] $ TFOp instr [b]
where where
[b] = freshes 1 [b] = freshes 1
-}
builtinLookup :: Var v => Map.Map Reference (SuperNormal v) builtinLookup :: Var v => Map.Map Reference (SuperNormal v)
builtinLookup builtinLookup
@ -1440,78 +1441,34 @@ declareForeigns = do
. mkForeign $ \(mv :: MVar Closure) -> tryReadMVar mv . mkForeign $ \(mv :: MVar Closure) -> tryReadMVar mv
-- Hashing functions -- Hashing functions
let hasher :: forall v alg . Var v => Hash.HashAlgorithm alg => Text -> alg -> FDecl v () let declareHashAlgorithm :: forall v alg . Var v => Hash.HashAlgorithm alg => Text -> alg -> FDecl v ()
hasher txt alg = do declareHashAlgorithm txt alg = do
let algoRef = Builtin ("crypto.Hash." <> txt) let algoRef = Builtin ("crypto.HashAlgorithm." <> txt)
declareForeign ("crypto.Hash." <> txt) pfop0 . mkForeign $ \() -> declareForeign ("crypto.Hash." <> txt) pfop0 . mkForeign $ \() ->
pure (HashAlgorithm algoRef alg) pure (HashAlgorithm algoRef alg)
hasher "Sha3_512" Hash.SHA3_512 declareHashAlgorithm "Sha3_512" Hash.SHA3_512
hasher "Sha3_256" Hash.SHA3_256 declareHashAlgorithm "Sha3_256" Hash.SHA3_256
hasher "Sha2_512" Hash.SHA512 declareHashAlgorithm "Sha2_512" Hash.SHA512
hasher "Sha2_256" Hash.SHA256 declareHashAlgorithm "Sha2_256" Hash.SHA256
hasher "Blake2b_512" Hash.Blake2b_512 declareHashAlgorithm "Blake2b_512" Hash.Blake2b_512
hasher "Blake2b_256" Hash.Blake2b_256 declareHashAlgorithm "Blake2b_256" Hash.Blake2b_256
hasher "Blake2s_256" Hash.Blake2s_256 declareHashAlgorithm "Blake2s_256" Hash.Blake2s_256
declareForeign ("crypto.Hash.new") pfopb . mkForeign $ \(HashAlgorithm ref alg) -> declareForeign ("crypto.hash") pfopbb . mkForeign $ \(HashAlgorithm _ref _alg, _a :: Closure) ->
pure (Hasher ref $ Hash.hashInitWith alg) pure $ Bytes.empty -- todo : implement me
declareForeign "crypto.Hash.addBytes" pfopbb . mkForeign $ declareForeign "crypto.hashBytes" pfopbb . mkForeign $
\(b :: Bytes.Bytes, Hasher ref ctx) -> \(HashAlgorithm _ alg, b :: Bytes.Bytes) ->
pure (Hasher ref $ Hash.hashUpdates ctx (Bytes.chunks b)) let ctx = Hash.hashInitWith alg
in pure . Bytes.fromArray . Hash.hashFinalize $ Hash.hashUpdates ctx (Bytes.chunks b)
-- declareForeign "Hash.add" pfopbb . mkForeign $ declareForeign "crypto.hmacBytes" pfopbbb
-- \(Hasher ctx, x :: Closure) -> error "todo - Hash.add universal function" . 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)
declareForeign "crypto.Hash.finish" pfopb u :: a -> HMAC.HMAC a -> HMAC.HMAC a
. mkForeign $ \(Hasher _ ctx) -> pure (Bytes.fromArray $ Hash.hashFinalize ctx) u _ h = h -- to help typechecker along
in pure $ Bytes.fromArray out
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)
hostPreference :: Maybe Text -> SYS.HostPreference hostPreference :: Maybe Text -> SYS.HostPreference
hostPreference Nothing = SYS.HostAny hostPreference Nothing = SYS.HostAny

View File

@ -8,7 +8,6 @@ module Unison.Runtime.Decompile
import Prelude hiding (seq) import Prelude hiding (seq)
import Unison.Prelude import Unison.Prelude
import qualified Data.ByteArray
import Unison.ABT (absChain, substs, pattern AbsN') import Unison.ABT (absChain, substs, pattern AbsN')
import Unison.Term import Unison.Term
@ -24,7 +23,7 @@ import Unison.Reference (Reference)
import Unison.Runtime.ANF (RTag, CTag, Tag(..)) import Unison.Runtime.ANF (RTag, CTag, Tag(..))
import Unison.Runtime.Foreign import Unison.Runtime.Foreign
(Foreign, Hasher(..), HashAlgorithm(..), Hmacinator(..), maybeUnwrapBuiltin, maybeUnwrapForeign) (Foreign, HashAlgorithm(..), maybeUnwrapBuiltin, maybeUnwrapForeign)
import Unison.Runtime.Stack import Unison.Runtime.Stack
(Closure(..), pattern DataC, pattern PApV, IComb(..)) (Closure(..), pattern DataC, pattern PApV, IComb(..))
@ -32,7 +31,6 @@ import Unison.Codebase.Runtime (Error)
import Unison.Util.Pretty (lit) import Unison.Util.Pretty (lit)
import qualified Unison.Util.Bytes as By import qualified Unison.Util.Bytes as By
import qualified Crypto.MAC.HMAC as HMAC
import Unsafe.Coerce -- for Int -> Double import Unsafe.Coerce -- for Int -> Double
@ -107,9 +105,7 @@ decompileForeign
decompileForeign tyRef topTerms f decompileForeign tyRef topTerms f
| Just t <- maybeUnwrapBuiltin f = Right $ text () t | Just t <- maybeUnwrapBuiltin f = Right $ text () t
| Just b <- maybeUnwrapBuiltin f = Right $ decompileBytes b | 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 $ decompileHashAlgorithm h
| Just h <- maybeUnwrapBuiltin f = Right $ decompileHmacinator h
| Just s <- unwrapSeq f | Just s <- unwrapSeq f
= seq' () <$> traverse (decompile tyRef topTerms) s = seq' () <$> traverse (decompile tyRef topTerms) s
decompileForeign _ _ _ = err "cannot decompile Foreign" decompileForeign _ _ _ = err "cannot decompile Foreign"
@ -122,25 +118,5 @@ decompileBytes
decompileHashAlgorithm :: Var v => HashAlgorithm -> Term v () decompileHashAlgorithm :: Var v => HashAlgorithm -> Term v ()
decompileHashAlgorithm (HashAlgorithm r _) = ref () r 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 :: Foreign -> Maybe (Seq Closure)
unwrapSeq = maybeUnwrapForeign vectorRef unwrapSeq = maybeUnwrapForeign vectorRef

View File

@ -5,8 +5,6 @@
module Unison.Runtime.Foreign module Unison.Runtime.Foreign
( Foreign(..) ( Foreign(..)
, Hasher(..)
, Hmacinator(..)
, HashAlgorithm(..) , HashAlgorithm(..)
, unwrapForeign , unwrapForeign
, maybeUnwrapForeign , maybeUnwrapForeign
@ -26,7 +24,6 @@ import Unison.Reference (Reference)
import Unison.Referent (Referent) import Unison.Referent (Referent)
import qualified Unison.Type as Ty import qualified Unison.Type as Ty
import qualified Crypto.Hash as Hash import qualified Crypto.Hash as Hash
import qualified Crypto.MAC.HMAC as HMAC
import Unsafe.Coerce import Unsafe.Coerce
data Foreign where data Foreign where
@ -85,17 +82,7 @@ data HashAlgorithm where
-- Reference is a reference to the hash algorithm -- Reference is a reference to the hash algorithm
HashAlgorithm :: Hash.HashAlgorithm a => Reference -> a -> HashAlgorithm 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 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 :: forall f. BuiltinForeign f => f -> Foreign
wrapBuiltin x = Wrap r x wrapBuiltin x = Wrap r x

View File

@ -229,15 +229,9 @@ socketRef = Reference.Builtin "Socket"
mvarRef :: Reference mvarRef :: Reference
mvarRef = Reference.Builtin "MVar" mvarRef = Reference.Builtin "MVar"
hasherRef :: Reference
hasherRef = Reference.Builtin "crypto.Hash"
hashAlgorithmRef :: Reference hashAlgorithmRef :: Reference
hashAlgorithmRef = Reference.Builtin "crypto.HashAlgorithm" hashAlgorithmRef = Reference.Builtin "crypto.HashAlgorithm"
hmacRef :: Reference
hmacRef = Reference.Builtin "crypto.Hmac"
builtin :: Ord v => a -> Text -> Type v a builtin :: Ord v => a -> Text -> Type v a
builtin a = ref a . Reference.Builtin builtin a = ref a . Reference.Builtin