feat: add RSA builtin functions for signing (implemented in Haskell)

CONTRIBUTORS.markdown

@@ -85,3 +85,4 @@ The format for this list: name, GitHub handle
 * Greg Pfeil (@sellout)
 * Upendra Upadhyay (@upendra1997)
 * Dan Doel (@dolio)
+* Eric Torreborre (@etorreborre)

development.markdown

@@ -42,7 +42,7 @@ Some tests are executables instead:
 
 * `stack exec transcripts` runs the transcripts-related integration tests, found in `unison-src/transcripts`. You can add more tests to this directory.
 * `stack exec transcripts -- prefix-of-filename` runs only transcript tests with a matching filename prefix.
-* `stack exec integration-tests` runs the additional integration tests for cli. These tests are not triggered by `tests` or `trancscripts`.
+* `stack exec integration-tests` runs the additional integration tests for cli. These tests are not triggered by `tests` or `transcripts`.
 * `stack exec unison -- transcript unison-src/transcripts-round-trip/main.md` runs the pretty-printing round trip tests
 * `stack exec unison -- transcript unison-src/transcripts-manual/benchmarks.md` runs the benchmark suite. Output goes in unison-src/transcripts-manual/benchmarks/output.txt.
 

parser-typechecker/package.yaml

@@ -23,6 +23,8 @@ dependencies:
   - NanoID
   - aeson
   - ansi-terminal
+  - asn1-encoding
+  - asn1-types
   - async
   - atomic-primops
   - base
@@ -160,6 +162,7 @@ tests:
       - easytest
       - filemanip
       - split
+      - hex-text
       - unison-parser-typechecker
     when:
       - condition: false

parser-typechecker/src/Unison/Builtin.hs

@@ -775,6 +775,10 @@ cryptoBuiltins =
   [ B "crypto.Ed25519.sign.impl" $
       bytes --> bytes --> bytes --> eithert failure bytes,
     B "crypto.Ed25519.verify.impl" $
+      bytes --> bytes --> bytes --> eithert failure boolean,
+    B "crypto.Rsa.sign.impl" $
+      bytes --> bytes --> eithert failure bytes,
+    B "crypto.Rsa.verify.impl" $
       bytes --> bytes --> bytes --> eithert failure boolean
   ]
 

parser-typechecker/src/Unison/Runtime/Builtin.hs

@@ -39,6 +39,7 @@ import Crypto.Error (CryptoError (..), CryptoFailable (..))
 import Crypto.Hash qualified as Hash
 import Crypto.MAC.HMAC qualified as HMAC
 import Crypto.PubKey.Ed25519 qualified as Ed25519
+import Crypto.PubKey.RSA.PKCS15 qualified as RSA
 import Crypto.Random (getRandomBytes)
 import Data.Bits (shiftL, shiftR, (.|.))
 import Data.ByteArray qualified as BA
@@ -153,6 +154,7 @@ import System.Process as SYS
   )
 import System.X509 qualified as X
 import Unison.ABT.Normalized hiding (TTm)
+import Unison.Runtime.Crypto.Rsa as Rsa
 import Unison.Builtin qualified as Ty (builtinTypes)
 import Unison.Builtin.Decls qualified as Ty
 import Unison.Prelude hiding (Text, some)
@@ -2933,6 +2935,14 @@ declareForeigns = do
     . mkForeign
     $ pure . verifyEd25519Wrapper
 
+  declareForeign Untracked "crypto.Rsa.sign.impl" boxBoxToEFBox
+    . mkForeign
+    $ pure . signRsaWrapper
+
+  declareForeign Untracked "crypto.Rsa.verify.impl" boxBoxBoxToEFBool
+    . mkForeign
+    $ pure . verifyRsaWrapper
+
   let catchAll :: (MonadCatch m, MonadIO m, NFData a) => m a -> m (Either Util.Text.Text a)
       catchAll e = do
         e <- Exception.tryAnyDeep e
@@ -3574,6 +3584,31 @@ verifyEd25519Wrapper (public0, msg0, sig0) = case validated of
       "ed25519: Secret key structure invalid"
     errMsg _ = "ed25519: unexpected error"
 
+signRsaWrapper ::
+  (Bytes.Bytes, Bytes.Bytes) -> Either Failure Bytes.Bytes
+signRsaWrapper (secret0, msg0) = case validated of
+  Left err ->
+    Left (Failure Ty.cryptoFailureRef err unitValue)
+  Right secret ->
+    case RSA.sign Nothing (Just Hash.SHA256) secret msg of
+      Left err -> Left (Failure Ty.cryptoFailureRef (Rsa.rsaErrorToText err) unitValue)
+      Right signature -> Right $ Bytes.fromByteString signature
+  where
+    msg = Bytes.toArray msg0 :: ByteString
+    validated = Rsa.parseRsaPrivateKey (Bytes.toArray secret0 :: ByteString)
+
+verifyRsaWrapper ::
+  (Bytes.Bytes, Bytes.Bytes, Bytes.Bytes) -> Either Failure Bool
+verifyRsaWrapper (public0, msg0, sig0) = case validated of
+  Left err ->
+    Left $ Failure Ty.cryptoFailureRef err unitValue
+  Right public ->
+    Right $ RSA.verify (Just Hash.SHA256) public msg sig
+  where
+    msg = Bytes.toArray msg0 :: ByteString
+    sig = Bytes.toArray sig0 :: ByteString
+    validated = Rsa.parseRsaPublicKey (Bytes.toArray public0 :: ByteString)
+
 typeReferences :: [(Reference, Word64)]
 typeReferences = zip rs [1 ..]
   where

parser-typechecker/src/Unison/Runtime/Crypto/Rsa.hs

@@ -0,0 +1,127 @@
+module Unison.Runtime.Crypto.Rsa (
+  parseRsaPublicKey,
+  parseRsaPrivateKey,
+  rsaErrorToText,
+) where
+
+import Crypto.Number.Basic qualified as Crypto
+import Crypto.PubKey.RSA qualified as RSA
+import Data.ASN1.BinaryEncoding qualified as ASN1
+import Data.ASN1.BitArray qualified as ASN1
+import Data.ASN1.Encoding qualified as ASN1
+import Data.ASN1.Error qualified as ASN1
+import Data.ASN1.Types qualified as ASN1
+import Data.ByteString qualified as BS
+import Data.ByteString.Lazy qualified as BSL
+import Unison.Util.Text (Text)
+import Unison.Util.Text qualified as Util.Text
+
+-- | Parse a RSA public key from a ByteString
+--   The input bytestring is a hex-encoded string of the DER file for the public key.
+--   It can be generated with those commands:
+--     # generate a RSA key of a given size
+--     openssl genrsa -out private_key.pem <size>
+--     # output the DER format as a hex string
+--     openssl rsa -in private_key.pem -outform DER -pubout | xxd -p
+parseRsaPublicKey :: BS.ByteString -> Either Text RSA.PublicKey
+parseRsaPublicKey bs = case ASN1.decodeASN1 ASN1.DER (BSL.fromStrict bs) of
+  Left err -> Left $ "rsa: cannot decode as an ASN.1 structure. " <> asn1ErrorToText err
+  Right asn1 ->
+    case asn1 of
+      [ ASN1.Start ASN1.Sequence,
+        ASN1.Start ASN1.Sequence,
+        ASN1.OID _,
+        ASN1.Null,
+        ASN1.End ASN1.Sequence,
+        ASN1.BitString (ASN1.BitArray _ bits),
+        ASN1.End ASN1.Sequence
+        ] -> case ASN1.decodeASN1 ASN1.DER (BSL.fromStrict bits) of
+          Left err -> Left $ "rsa: cannot decode as an ASN.1 inner structure. " <> asn1ErrorToText err
+          Right asn1 -> case asn1 of
+            [ASN1.Start ASN1.Sequence, ASN1.IntVal n, ASN1.IntVal e, ASN1.End ASN1.Sequence] ->
+              Right
+                RSA.PublicKey
+                  { public_size = Crypto.numBytes n,
+                    public_n = n,
+                    public_e = e
+                  }
+            other -> Left ("rsa: unexpected ASN.1 inner structure for a RSA public key" <> Util.Text.pack (show other))
+      other -> Left ("rsa: unexpected ASN.1 outer structure for a RSA public key" <> Util.Text.pack (show other))
+
+-- | Parse a RSA private key from a ByteString
+--   The input bytestring is a hex-encoded string of the DER file for the private key.
+--   It can be generated with those commands:
+--     # generate a RSA key of a given size
+--     openssl genrsa -out private_key.pem <size>
+--     # output the DER format as a hex string
+--     openssl rsa -in private_key.pem -outform DER | xxd -p
+parseRsaPrivateKey :: BS.ByteString -> Either Text RSA.PrivateKey
+parseRsaPrivateKey bs = case ASN1.decodeASN1 ASN1.DER (BSL.fromStrict bs) of
+  Left err -> Left $ "Error decoding ASN.1: " <> asn1ErrorToText err
+  Right asn1 ->
+    case asn1 of
+      [ ASN1.Start ASN1.Sequence,
+        ASN1.IntVal 0,
+        ASN1.Start ASN1.Sequence,
+        ASN1.OID _,
+        ASN1.Null,
+        ASN1.End ASN1.Sequence,
+        ASN1.OctetString bits,
+        ASN1.End ASN1.Sequence
+        ] ->
+          case ASN1.decodeASN1 ASN1.DER (BSL.fromStrict bits) of
+            Left err -> Left $ "Error decoding inner ASN.1: " <> asn1ErrorToText err
+            Right asn1 ->
+              case asn1 of
+                [ ASN1.Start ASN1.Sequence,
+                  ASN1.IntVal _,
+                  ASN1.IntVal n,
+                  ASN1.IntVal e,
+                  ASN1.IntVal d,
+                  ASN1.IntVal p,
+                  ASN1.IntVal q,
+                  ASN1.IntVal dP,
+                  ASN1.IntVal dQ,
+                  ASN1.IntVal qinv,
+                  ASN1.End ASN1.Sequence
+                  ] ->
+                    Right
+                      RSA.PrivateKey
+                        { private_pub = RSA.PublicKey {public_size = Crypto.numBytes n, public_n = n, public_e = e},
+                          private_d = d,
+                          private_p = p,
+                          private_q = q,
+                          private_dP = dP,
+                          private_dQ = dQ,
+                          private_qinv = qinv
+                        }
+                other -> Left ("rsa: unexpected inner ASN.1 structure for a RSA private key" <> Util.Text.pack (show other))
+      other -> Left ("rsa: unexpected outer ASN.1 structure for a RSA private key" <> Util.Text.pack (show other))
+
+-- | Display an ASN1 Error
+asn1ErrorToText :: ASN1.ASN1Error -> Text
+asn1ErrorToText = \case
+  ASN1.StreamUnexpectedEOC -> "Unexpected EOC in the stream"
+  ASN1.StreamInfinitePrimitive -> "Invalid primitive with infinite length in a stream"
+  ASN1.StreamConstructionWrongSize -> "A construction goes over the size specified in the header"
+  ASN1.StreamUnexpectedSituation s -> "An unexpected situation has come up parsing an ASN1 event stream: " <> Util.Text.pack s
+  ASN1.ParsingHeaderFail s -> "Parsing an invalid header: " <> Util.Text.pack s
+  ASN1.ParsingPartial -> "Parsing is not finished, the key is not complete"
+  ASN1.TypeNotImplemented s -> "Decoding of a type that is not implemented: " <> Util.Text.pack s
+  ASN1.TypeDecodingFailed s -> "Decoding of a known type failed: " <> Util.Text.pack s
+  ASN1.TypePrimitiveInvalid s -> "Invalid primitive type: " <> Util.Text.pack s
+  ASN1.PolicyFailed s1 s2 -> "Policy failed. Policy name: " <> Util.Text.pack s1 <> ", reason:" <> Util.Text.pack s2
+
+-- | Display a RSA Error
+rsaErrorToText :: RSA.Error -> Text
+rsaErrorToText = \case
+  RSA.MessageSizeIncorrect ->
+    "rsa: The message to decrypt is not of the correct size (need to be == private_size)"
+  RSA.MessageTooLong ->
+    "rsa: The message to encrypt is too long"
+  RSA.MessageNotRecognized ->
+    "rsa: The message decrypted doesn't have a PKCS15 structure (0 2 .. 0 msg)"
+  RSA.SignatureTooLong ->
+    "rsa: The message's digest is too long"
+  RSA.InvalidParameters ->
+    "rsa: Some parameters lead to breaking assumptions"

parser-typechecker/tests/Unison/Test/Runtime/Crypto/Rsa.hs

@@ -0,0 +1,48 @@
+module Unison.Test.Runtime.Crypto.Rsa where
+
+import Crypto.PubKey.RSA qualified as RSA
+import Data.Maybe (fromJust)
+import EasyTest
+import Text.Hex
+import Unison.Runtime.Crypto.Rsa
+
+test :: Test ()
+test =
+  scope "parsing" $
+    tests
+      [ scope "parseRsaPublicKey" parseRsaPublicKeyTest,
+        scope "parseRsaPrivateKey" parseRsaPrivateKeyTest
+      ]
+
+parseRsaPublicKeyTest :: Test ()
+parseRsaPublicKeyTest = do
+  let publicKey = fromJust $ decodeHex "30819f300d06092a864886f70d010101050003818d0030818902818100a7104b2f20725896076e629ccedbcd6907b16694c6e3d8768b5e0e685670b49616e796c588e5aafb92ef986c1a42c021fed0bdc99212c969cdab98087a0ee4c2f4acd4b6049a87a96afc45668329a3cf21a86fb13b488bbe9fefa1cd5a459014f0d0101378e9661e11b73acf54c8a91141ac90309e7fb6ed69b4e63230ab29150203010001"
+  let actual = parseRsaPublicKey publicKey
+  let expected =
+        RSA.PublicKey
+          { public_size = 128,
+            public_n = 117316082691067466889305872575557202673362950667744445659499028356561021937142613205104589546643406309814005581397307365793352915031830083408196867291689544964758311244905648512755140288413724266536406258908443053617981341387254220659107167969619543916073994027510270571746462643891169516098953507692950006037,
+            public_e = 65537
+          }
+  expectEqual actual (Right expected)
+
+parseRsaPrivateKeyTest :: Test ()
+parseRsaPrivateKeyTest = do
+  let privateKey = fromJust $ decodeHex "30820276020100300d06092a864886f70d0101010500048202603082025c02010002818100a7104b2f20725896076e629ccedbcd6907b16694c6e3d8768b5e0e685670b49616e796c588e5aafb92ef986c1a42c021fed0bdc99212c969cdab98087a0ee4c2f4acd4b6049a87a96afc45668329a3cf21a86fb13b488bbe9fefa1cd5a459014f0d0101378e9661e11b73acf54c8a91141ac90309e7fb6ed69b4e63230ab291502030100010281807cdc23a4fc3619d93f8293b728af848d0c0fdd603269d5bd7b99f760a9c22065d08693dbdcddf1f5863306133d694819e04d789aef4e95343b601507b8d9eac4492e6d7031b035c5d84eceaa9686b292712632d33b3303af84314d7920bc3d45f90d7818fc2587b129196d378ee4ed3e6b8d9010d504bb6470ff53e7c5fb17a1024100d67cbcf113d24325fcef12a778dc47c7060055290b68287649ef092558daccb61c4e7bc290740b75a29d4356dcbd66d18b0860dbff394cc8ff3d94d57617adbd024100c765d8261dd3d8e0d3caf11ab7b212eed181354215687ca6387283e4f0be16e79c8f298be0a70c7734dea78ea65128517d693cabfa4c0ff5328f2abb85d2023902403ca41dc347285e65c22251b2d9bfe5e7463217e1b7e0e5f7b3a58a7f6da4c6d60220ca6ad2ee8c42e10bf77afa83ee2af6551315800e52404db1ba7fb398b43d02410084877d85c0177933ddb12a554eb8edfa8b872c85d2c2d2ee8be019280696e19469ab81bab5c371f69d4e4be1f54b45d7fbda017870f1333e0eafb78051ee8689024061f694c12e934c44b7734f62d1b2a3d3624a4980e1b8e066d78dbabd2436654fbb9d9701425900daaafa1e031310e8a580520bb9e1c1288c669fce252bad1e65"
+  let actual = parseRsaPrivateKey privateKey
+  let expected =
+        RSA.PrivateKey
+          { private_pub =
+              RSA.PublicKey
+                { public_size = 128,
+                  public_n = 117316082691067466889305872575557202673362950667744445659499028356561021937142613205104589546643406309814005581397307365793352915031830083408196867291689544964758311244905648512755140288413724266536406258908443053617981341387254220659107167969619543916073994027510270571746462643891169516098953507692950006037,
+                  public_e = 65537
+                },
+            private_d = 87679616801061623139678211462583995973938243841750319557622746050821908471598979773246073219465960975647341309221073776399960619667883322633274192544886774496262613234964971623744931197514942326521327825606791139576216469817618072158660015124292686556025876602526093941289386692302798356532230087066424907681,
+            private_p = 11233609214744923027767175501352593646202568021007351512424743595719525825944483790453654486119375677127184086533073126720964060366977171672432803562630589,
+            private_q = 10443311712951670023099443962737058583295522901049380734330015511797675780053495867511334370071427510893202629294375157939437054042246322949533759718949433,
+            private_dP = 3176031022781156885141187342486873181111240716865972140527001145690023864823311109042460960576558461960260523664057127500690343997127119244373520564139069,
+            private_dQ = 6941120510619372179626602981107825119089517097926514417911731475020140673258620725588998791918173107511741662411060736754565186643059761376912904765212297,
+            private_qinv = 5130749483925715543854508655089227892147425255568362503702389513480166321367311031864242660308321705497233758877799126086240198385610964125158868020698725
+          }
+  expectEqual actual (Right expected)

parser-typechecker/unison-parser-typechecker.cabal

@@ -143,6 +143,7 @@ library
       Unison.Runtime.ANF.Serialize
       Unison.Runtime.Array
       Unison.Runtime.Builtin
+      Unison.Runtime.Crypto.Rsa
       Unison.Runtime.Debug
       Unison.Runtime.Decompile
       Unison.Runtime.Exception
@@ -232,6 +233,8 @@ library
     , NanoID
     , aeson
     , ansi-terminal
+    , asn1-encoding
+    , asn1-types
     , async
     , atomic-primops
     , base
@@ -372,6 +375,7 @@ test-suite parser-typechecker-tests
       Unison.Test.DataDeclaration
       Unison.Test.MCode
       Unison.Test.Referent
+      Unison.Test.Runtime.Crypto.Rsa
       Unison.Test.Syntax.FileParser
       Unison.Test.Syntax.TermParser
       Unison.Test.Syntax.TypePrinter
@@ -425,6 +429,8 @@ test-suite parser-typechecker-tests
     , NanoID
     , aeson
     , ansi-terminal
+    , asn1-encoding
+    , asn1-types
     , async
     , atomic-primops
     , base
@@ -461,6 +467,7 @@ test-suite parser-typechecker-tests
     , hashable
     , hashtables
     , haskeline
+    , hex-text
     , http-client
     , http-media
     , http-types