Begin wrapping BoringSSL’s error type

1 files changed, 30 insertions, 1 deletions

diff --git a/src/BTLS/Result.hs b/src/BTLS/Result.hs
index 6cac7b9..7cd5839 100644
--- a/src/BTLS/Result.hs
+++ b/src/BTLS/Result.hs
@@ -12,14 +12,43 @@
 -- License for the specific language governing permissions and limitations under
 -- the License.
 
-module BTLS.Result where
+module BTLS.Result
+  ( alwaysSucceeds, requireSuccess
+  , Error, file, line, errorData, errorDataIsHumanReadable
+  ) where
 
 import Control.Exception (assert)
 import Control.Monad (when)
+import Data.Bits ((.&.))
+import Data.ByteString (ByteString)
+import Foreign (allocaArray)
+import Foreign.C.String (peekCString)
 import Foreign.C.Types
+import Foreign.Marshal.Unsafe (unsafeLocalState)
+
+import BTLS.BoringSSL.Err
 
 alwaysSucceeds :: CInt -> IO ()
 alwaysSucceeds r = assert (r == 1) (return ())
 
 requireSuccess :: CInt -> IO ()
 requireSuccess r = when (r /= 1) $ ioError (userError "BoringSSL failure")
+
+data Error = Error
+  { err :: Err
+  , file :: FilePath
+  , line :: Int
+  , errorData :: Maybe ByteString
+  , flags :: CInt
+  } deriving Eq
+
+errorDataIsHumanReadable :: Error -> Bool
+errorDataIsHumanReadable e = flags e .&. errFlagString == 1
+
+instance Show Error where
+  show e =
+    let len = 120 in
+    unsafeLocalState $
+      allocaArray len $ \pOut -> do
+        errErrorStringN (err e) pOut len
+        peekCString pOut