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' "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 =

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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