cloudi 2.0.5 → 2.0.6

raw patch · 4 files changed

+98/−44 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• cloudi.cabal +2/−2
• src/Foreign/CloudI.hs +48/−9
• src/Foreign/Erlang.hs +47/−32

@@ -1,6 +1,6 @@ MIT License
 
-Copyright (c) 2017-2022 Michael Truog <mjtruog at protonmail dot com>
+Copyright (c) 2017-2023 Michael Truog <mjtruog at protonmail dot com>
 
 Permission is hereby granted, free of charge, to any person obtaining a
 copy of this software and associated documentation files (the "Software"),

@@ -1,5 +1,5 @@ name:                cloudi-version:             2.0.5+version:             2.0.6 synopsis:            Haskell CloudI API description:         Haskell CloudI API (see https://cloudi.org for more details) homepage:            https://github.com/CloudI/cloudi_api_haskell@@ -7,7 +7,7 @@ license-file:        LICENSE author:              Michael Truog maintainer:          mjtruog at protonmail dot com-copyright:           2017-2022 Michael Truog+copyright:           2017-2023 Michael Truog category:            Foreign stability:           provisional build-type:          Simple

@@ -5,7 +5,7 @@    MIT License -  Copyright (c) 2017-2022 Michael Truog <mjtruog at protonmail dot com>+  Copyright (c) 2017-2023 Michael Truog <mjtruog at protonmail dot com>    Permission is hereby granted, free of charge, to any person obtaining a   copy of this software and associated documentation files (the "Software"),@@ -60,14 +60,19 @@     , returnSync     , recvAsync     , processIndex+    , processIndex_     , processCount     , processCountMax+    , processCountMax_     , processCountMin+    , processCountMin_     , prefix     , timeoutInitialize+    , timeoutInitialize_     , timeoutAsync     , timeoutSync     , timeoutTerminate+    , timeoutTerminate_     , priorityDefault     , poll     , shutdown@@ -241,13 +246,7 @@  -- | returns the thread count from the service configuration threadCount :: IO (Result Int)-threadCount = do-    threadCountValue <- POSIX.getEnv "CLOUDI_API_INIT_THREAD_COUNT"-    case threadCountValue of-        Nothing ->-            return $ Left invalidInputError-        Just threadCountStr ->-            return $ Right (read threadCountStr :: Int)+threadCount = getEnvToUnsignedInt "CLOUDI_API_INIT_THREAD_COUNT"  -- | subscribes to a service name pattern with a callback subscribe :: Instance.T s -> ByteString -> Instance.Callback s ->@@ -609,6 +608,10 @@ processIndex Instance.T{Instance.processIndex = processIndex'} =     processIndex' +-- | returns the 0-based index of this process in the service instance+processIndex_ :: IO (Result Int)+processIndex_ = getEnvToUnsignedInt "CLOUDI_API_INIT_PROCESS_INDEX"+ -- | returns the current process count based on the service configuration processCount :: Instance.T s -> Int processCount Instance.T{Instance.processCount = processCount'} =@@ -620,12 +623,22 @@ processCountMax Instance.T{Instance.processCountMax = processCountMax'} =     processCountMax' +-- | returns the count_process_dynamic maximum count+-- based on the service configuration+processCountMax_ :: IO (Result Int)+processCountMax_ = getEnvToUnsignedInt "CLOUDI_API_INIT_PROCESS_COUNT_MAX"+ -- | returns the count_process_dynamic minimum count -- based on the service configuration processCountMin :: Instance.T s -> Int processCountMin Instance.T{Instance.processCountMin = processCountMin'} =     processCountMin' +-- | returns the count_process_dynamic minimum count+-- based on the service configuration+processCountMin_ :: IO (Result Int)+processCountMin_ = getEnvToUnsignedInt "CLOUDI_API_INIT_PROCESS_COUNT_MIN"+ -- | returns the service name pattern prefix from the service configuration prefix :: Instance.T s -> ByteString prefix Instance.T{Instance.prefix = prefix'} =@@ -637,6 +650,11 @@ timeoutInitialize Instance.T{Instance.timeoutInitialize = timeoutInitialize'} =     timeoutInitialize' +-- | returns the service initialization timeout+-- from the service configuration+timeoutInitialize_ :: IO (Result Int)+timeoutInitialize_ = getEnvToUnsignedInt "CLOUDI_API_INIT_TIMEOUT_INITIALIZE"+ -- | returns the default asynchronous service request send timeout -- from the service configuration timeoutAsync :: Instance.T s -> Int@@ -655,6 +673,11 @@ timeoutTerminate Instance.T{Instance.timeoutTerminate = timeoutTerminate'} =     timeoutTerminate' +-- | returns the service termination timeout+-- based on the service configuration+timeoutTerminate_ :: IO (Result Int)+timeoutTerminate_ = getEnvToUnsignedInt "CLOUDI_API_INIT_TIMEOUT_TERMINATE"+ -- | returns the default service request send priority -- from the service configuration priorityDefault :: Instance.T s -> Int@@ -863,6 +886,7 @@             timeoutTerminate' <- Get.getWord32host             priorityDefault' <- Get.getInt8             fatalExceptions' <- Get.getInt8+            bind <- Get.getInt32host             let api1 = Instance.init api0                     processIndex'                     processCount'@@ -876,7 +900,9 @@                     priorityDefault'                     fatalExceptions'             empty <- Get.isEmpty-            if not empty then+            if bind >= 0 then+                fail invalidInputError+            else if not empty then                 handleEvents messages api1 external 0             else                 return (messages, api1)@@ -1230,6 +1256,19 @@ setTerminate api0 =     api0{ Instance.terminate = True         , Instance.timeout = Just False}++getEnvToUnsignedInt :: String -> IO (Result Int)+getEnvToUnsignedInt name = do+    valueResult <- POSIX.getEnv name+    case valueResult of+        Nothing ->+            return $ Left invalidInputError+        Just valueStr ->+            let value = read valueStr :: Int in+            if value < 0 then+                return $ Left invalidInputError+            else+                return $ Right value  threadList :: Concurrent.MVar [Concurrent.MVar ()] threadList = Unsafe.unsafePerformIO (Concurrent.newMVar [])

@@ -5,7 +5,7 @@    MIT License -  Copyright (c) 2017-2022 Michael Truog <mjtruog at protonmail dot com>+  Copyright (c) 2017-2023 Michael Truog <mjtruog at protonmail dot com>    Permission is hereby granted, free of charge, to any person obtaining a   copy of this software and associated documentation files (the "Software"),@@ -132,6 +132,10 @@ tagAtomUtf8Ext = 118 tagSmallAtomUtf8Ext :: Word8 tagSmallAtomUtf8Ext = 119+tagV4PortExt :: Word8+tagV4PortExt = 120+tagLocalExt :: Word8+tagLocalExt = 121  data OtpErlangTerm =       OtpErlangInteger Int@@ -266,16 +270,23 @@             str <- Get.getByteString 31             let value = Char8.unpack $ Char8.takeWhile (\c -> c /= '\0') str             return $ OtpErlangFloat (read value :: Double)-        | tag == tagNewPortExt ||+        | tag == tagV4PortExt || tag == tagNewPortExt ||           tag == tagReferenceExt || tag == tagPortExt -> do             (nodeTag, node) <- binaryToAtom-            eid <- Get.getByteString 4-            let creationSize = if tag == tagNewPortExt then 4 else 1+            let idSize = if tag == tagV4PortExt then 8 else 4+            eid <- Get.getByteString idSize+            let creationSize =+                    if tag == tagV4PortExt || tag == tagNewPortExt then+                        4+                    else+                        1             creation <- Get.getByteString creationSize             if tag == tagReferenceExt then                 return $ OtpErlangReference $ E.Reference                     nodeTag node eid creation-            else -- tag == tagNewPortExt || tag == tagPortExt+            else+                -- tag == tagV4PortExt || tag == tagNewPortExt ||+                -- tag == tagPortExt                 return $ OtpErlangPort $ E.Port                     nodeTag node eid creation         | tag == tagNewPidExt || tag == tagPidExt -> do@@ -381,6 +392,8 @@                         fail err                     Right (_, _, term) ->                         return term+        | tag == tagLocalExt ->+            fail $ "LOCAL_EXT is opaque"         | otherwise ->             fail $ "invalid tag" @@ -395,31 +408,6 @@     value <- binaryToTerms     return (key, value) -binaryToExportSize :: Get Int-binaryToExportSize = do-    oldI <- Get.bytesRead-    (_, _) <- binaryToAtom -- module-    (_, _) <- binaryToAtom -- function-    arityTag <- Get.getWord8-    _ <- Get.getWord8 -- arity-    i <- Get.bytesRead-    if arityTag == tagSmallIntegerExt then-        return $ fromIntegral (i - oldI)-    else-        fail $ "invalid small integer tag"--binaryToFunSize :: Get Int-binaryToFunSize = do-    oldI <- Get.bytesRead-    numfree <- Get.getWord32be-    _ <- binaryToPid -- pid-    (_, _) <- binaryToAtom -- module-    _ <- binaryToInteger -- index-    _ <- binaryToInteger -- uniq-    _ <- binaryToTermSequence (getUnsignedInt32 numfree) -- free-    i <- Get.bytesRead-    return $ fromIntegral (i - oldI)- binaryToInteger :: Get Int binaryToInteger = do     tag <- Get.getWord8@@ -454,6 +442,31 @@         | otherwise ->             fail $ "invalid pid tag" +binaryToExportSize :: Get Int+binaryToExportSize = do+    oldI <- Get.bytesRead+    (_, _) <- binaryToAtom -- module+    (_, _) <- binaryToAtom -- function+    arityTag <- Get.getWord8+    _ <- Get.getWord8 -- arity+    i <- Get.bytesRead+    if arityTag == tagSmallIntegerExt then+        return $ fromIntegral (i - oldI)+    else+        fail $ "invalid small integer tag"++binaryToFunSize :: Get Int+binaryToFunSize = do+    oldI <- Get.bytesRead+    numfree <- Get.getWord32be+    _ <- binaryToPid -- pid+    (_, _) <- binaryToAtom -- module+    _ <- binaryToInteger -- index+    _ <- binaryToInteger -- uniq+    _ <- binaryToTermSequence (getUnsignedInt32 numfree) -- free+    i <- Get.bytesRead+    return $ fromIntegral (i - oldI)+ binaryToAtom :: Get (Word8, ByteString) binaryToAtom = do     tag <- Get.getWord8@@ -594,7 +607,7 @@     let length = ByteString.length value in     if length <= 4294967295 then         ok $ Builder.toLazyByteString $-            Builder.word8 tagBinaryExt <>+            Builder.word8 tagBitBinaryExt <>             Builder.word32BE (fromIntegral length) <>             Builder.word8 (fromIntegral bits) <>             Builder.byteString value@@ -683,7 +696,9 @@         Builder.byteString creation termsToBinary (OtpErlangPort (E.Port nodeTag node eid creation)) =     let tag =-            if (ByteString.length creation) == 4 then+            if (ByteString.length eid) == 8 then+                tagV4PortExt+            else if (ByteString.length creation) == 4 then                 tagNewPortExt             else                 tagPortExt in