1 files changed, 54 insertions, 0 deletions

diff --git a/Compat.hs b/Compat.hs
new file mode 100644
index 0000000..43f62c0
--- /dev/null
+++ b/Compat.hs
@@ -0,0 +1,54 @@
+module Compat where
+
+import Data.Bits
+import Data.Word
+import Data.ASN1.Types
+import Data.ASN1.Encoding
+import Data.ASN1.BinaryEncoding
+import Crypto.PubKey.RSA as RSA
+
+instance ASN1Object PublicKey where
+    toASN1 pubKey = \xs -> Start Sequence
+                         : IntVal (public_n pubKey)
+                         : IntVal (public_e pubKey)
+                         : End Sequence
+                         : xs
+    fromASN1 (Start Sequence:IntVal smodulus:IntVal pubexp:End Sequence:xs) =
+        Right (PublicKey { public_size = calculate_modulus modulus 1
+                         , public_n    = modulus
+                         , public_e    = pubexp
+                         }
+              , xs)
+        where calculate_modulus n i = if (2 ^ (i * 8)) > n then i else calculate_modulus n (i+1)
+              -- some bad implementation will not serialize ASN.1 integer properly, leading
+              -- to negative modulus. if that's the case, we correct it.
+              modulus = toPositive smodulus
+    fromASN1 ( Start Sequence
+             : IntVal 0
+             : Start Sequence
+             : OID [1, 2, 840, 113549, 1, 1, 1]
+             : Null
+             : End Sequence
+             : OctetString bs
+             : xs
+             ) = let inner = either strError fromASN1 $ decodeASN1' BER bs
+                     strError = Left .
+                                ("fromASN1: RSA.PublicKey: " ++) . show
+                 in either Left (\(k, _) -> Right (k, xs)) inner
+    fromASN1 _ =
+        Left "fromASN1: RSA.PublicKey: unexpected format"
+
+
+toPositive :: Integer -> Integer
+toPositive int
+    | int < 0   = uintOfBytes $ bytesOfInt int
+    | otherwise = int
+  where uintOfBytes = foldl (\acc n -> (acc `shiftL` 8) + fromIntegral n) 0
+        bytesOfInt :: Integer -> [Word8]
+        bytesOfInt n = if testBit (head nints) 7 then nints else 0xff : nints
+          where nints = reverse $ plusOne $ reverse $ map complement $ bytesOfUInt (abs n)
+                plusOne []     = [1]
+                plusOne (x:xs) = if x == 0xff then 0 : plusOne xs else (x+1) : xs
+                bytesOfUInt x = reverse (list x)
+                  where list i = if i <= 0xff then [fromIntegral i] else (fromIntegral i .&. 0xff) : list (i `shiftR` 8)
+