mirror of
https://github.com/unisonweb/unison.git
synced 2024-11-14 07:51:12 +03:00
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:
parent
f17fafb27f
commit
af9190ee22
@ -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 =
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user