cloudi 1.7.5 → 1.8.0

raw patch · 9 files changed

+107/−40 lines, 9 filesdep ~basedep ~networkPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, network

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• README.markdown +10/−0
• cloudi.cabal +19/−6
• src/Foreign/CloudI.hs +18/−1
• src/Foreign/CloudI/Instance.hs +4/−7
• src/Foreign/Erlang.hs +49/−19
• src/Foreign/Erlang/Pid.hs +2/−2
• src/Foreign/Erlang/Port.hs +2/−2
• src/Foreign/Erlang/Reference.hs +2/−2

@@ -1,6 +1,6 @@ MIT License
 
-Copyright (c) 2017-2018 Michael Truog <mjtruog at protonmail dot com>
+Copyright (c) 2017-2019 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"),

@@ -8,11 +8,21 @@ Build ----- +With cabal-install < 2.4+     cabal sandbox init     cabal update     cabal install --only-dependencies     cabal configure     cabal build++With cabal-install >= 2.4++    cabal v1-sandbox init+    cabal v1-update+    cabal v1-install --only-dependencies+    cabal v1-configure+    cabal v1-build  Author ------

@@ -1,5 +1,5 @@ name:                cloudi-version:             1.7.5+version:             1.8.0 synopsis:            Haskell CloudI API description:         Haskell CloudI API (see https://cloudi.org for more details) homepage:            https://github.com/CloudI/cloudi_api_haskell@@ -7,14 +7,24 @@ license-file:        LICENSE author:              Michael Truog maintainer:          mjtruog at protonmail dot com-copyright:           2017-2018 Michael Truog+copyright:           2017-2019 Michael Truog category:            Foreign stability:           provisional build-type:          Simple cabal-version:       1.22-tested-with:         GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3+tested-with:           GHC == 7.10.3+                     , GHC == 8.0.2+                     , GHC == 8.2.2+                     , GHC == 8.4.3+                     , GHC == 8.6.5+                     , GHC == 8.8.1 extra-source-files:  README.markdown changelog.md +flag dev+  description:        Turn on development settings.+  manual:             True+  default:            False+ library   hs-source-dirs:    src   exposed-modules:     Foreign.CloudI@@ -24,13 +34,16 @@                      , Foreign.Erlang.Reference                      , Foreign.Erlang.Function   other-modules:       Foreign.CloudI.Instance-  ghc-options:       -Wall -funbox-strict-fields-  build-depends:       base >= 4.8.2.0 && < 5+  if flag(dev)+    ghc-options:     -Wall -Werror -funbox-strict-fields+  else+    ghc-options:     -Wall -funbox-strict-fields+  build-depends:       base >= 4.8.2.0 && < 5.0                      , binary >= 0.8.4.0                      , bytestring >= 0.10.4+                     , network >= 3.0.0.0                      , array                      , containers-                     , network                      , time                      , unix                      , zlib

@@ -5,7 +5,7 @@    MIT License -  Copyright (c) 2017-2018 Michael Truog <mjtruog at protonmail dot com>+  Copyright (c) 2017-2019 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"),@@ -68,6 +68,7 @@     , timeoutSync     , timeoutTerminate     , poll+    , shutdown     , threadCreate     , threadsWait     , infoKeyValueParse@@ -995,6 +996,22 @@ poll :: Typeable s => Instance.T s -> Int -> IO (Result (Bool, Instance.T s)) poll api0 timeout =     pollRequest api0 timeout True++-- | shutdown the service successfully+shutdown :: Instance.T s -> Maybe ByteString ->+    IO (Result (Instance.T s))+shutdown api0 reasonOpt =+    let reason = fromMaybe Char8.empty reasonOpt+        shutdownTerms = Erlang.OtpErlangTuple+            [ Erlang.OtpErlangAtom (Char8.pack "shutdown")+            , Erlang.OtpErlangString reason]+    in+    case Erlang.termToBinary shutdownTerms (-1) of+        Left err ->+            return $ Left $ show err+        Right shutdownBinary -> do+            send api0 shutdownBinary+            return $ Right $ api0  send :: Instance.T s -> LazyByteString -> IO () send Instance.T{

@@ -5,7 +5,7 @@    MIT License -  Copyright (c) 2017 Michael Truog <mjtruog at protonmail dot com>+  Copyright (c) 2017-2019 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"),@@ -131,14 +131,11 @@  makeSocket :: String -> C.CInt -> IO Socket makeSocket "local" fd =-    Socket.mkSocket fd Socket.AF_UNIX Socket.Stream-        Socket.defaultProtocol Socket.Connected+    Socket.mkSocket fd makeSocket "tcp" fd =-    Socket.mkSocket fd Socket.AF_INET Socket.Stream-        Socket.defaultProtocol Socket.Connected+    Socket.mkSocket fd makeSocket "udp" fd =-    Socket.mkSocket fd Socket.AF_INET Socket.Datagram-        Socket.defaultProtocol Socket.Connected+    Socket.mkSocket fd makeSocket _ _ =     error "invalid protocol" 

@@ -5,7 +5,7 @@    MIT License -  Copyright (c) 2017-2018 Michael Truog <mjtruog at protonmail dot com>+  Copyright (c) 2017-2019 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"),@@ -80,6 +80,12 @@ tagBitBinaryExt = 77 tagAtomCacheRef :: Word8 tagAtomCacheRef = 78+tagNewPidExt :: Word8+tagNewPidExt = 88+tagNewPortExt :: Word8+tagNewPortExt = 89+tagNewerReferenceExt :: Word8+tagNewerReferenceExt = 90 tagSmallIntegerExt :: Word8 tagSmallIntegerExt = 97 tagIntegerExt :: Word8@@ -264,23 +270,24 @@             j <- Get.getWord16be             value <- Get.getByteString $ getUnsignedInt16 j             return $ OtpErlangAtom value-        | tag == tagReferenceExt || tag == tagPortExt -> do+        | tag == tagNewPortExt ||+          tag == tagReferenceExt || tag == tagPortExt -> do             (nodeTag, node) <- binaryToAtom             eid <- Get.getByteString 4-            creation <- Get.getWord8+            let creationSize = if tag == tagNewPortExt then 4 else 1+            creation <- Get.getByteString creationSize             if tag == tagReferenceExt then                 return $ OtpErlangReference $ E.Reference                     nodeTag node eid creation-            else if tag == tagPortExt then+            else -- tag == tagNewPortExt || tag == tagPortExt                 return $ OtpErlangPort $ E.Port                     nodeTag node eid creation-            else-                fail $ "invalid"-        | tag == tagPidExt -> do+        | tag == tagNewPidExt || tag == tagPidExt -> do             (nodeTag, node) <- binaryToAtom             eid <- Get.getByteString 4             serial <- Get.getByteString 4-            creation <- Get.getWord8+            let creationSize = if tag == tagNewPidExt then 4 else 1+            creation <- Get.getByteString creationSize             return $ OtpErlangPid $ E.Pid                 nodeTag node eid serial creation         | tag == tagSmallTupleExt || tag == tagLargeTupleExt -> do@@ -325,10 +332,11 @@             value <- Get.getByteString length             return $ OtpErlangFunction $ E.Function                 tag value-        | tag == tagNewReferenceExt -> do+        | tag == tagNewerReferenceExt || tag == tagNewReferenceExt -> do             j <- Get.getWord16be             (nodeTag, node) <- binaryToAtom-            creation <- Get.getWord8+            let creationSize = if tag == tagNewerReferenceExt then 4 else 1+            creation <- Get.getByteString creationSize             eid <- Get.getByteString $ (getUnsignedInt16 j) * 4             return $ OtpErlangReference $ E.Reference                 nodeTag node eid creation@@ -428,13 +436,20 @@ binaryToPid = do     tag <- Get.getWord8     case () of-      _ | tag == tagPidExt -> do+      _ | tag == tagNewPidExt -> do             (nodeTag, node) <- binaryToAtom             eid <- Get.getByteString 4             serial <- Get.getByteString 4-            creation <- Get.getWord8+            creation <- Get.getByteString 4             return $ E.Pid                 nodeTag node eid serial creation+        | tag == tagPidExt -> do+            (nodeTag, node) <- binaryToAtom+            eid <- Get.getByteString 4+            serial <- Get.getByteString 4+            creation <- Get.getByteString 1+            return $ E.Pid+                nodeTag node eid serial creation         | otherwise ->             fail $ "invalid pid tag" @@ -651,20 +666,30 @@     else         errorType $ OutputError "uint32 overflow" termsToBinary (OtpErlangPid (E.Pid nodeTag node eid serial creation)) =+    let tag =+            if (ByteString.length creation) == 4 then +                tagNewPidExt+            else+                tagPidExt in     ok $ Builder.toLazyByteString $-        Builder.word8 tagPidExt <>+        Builder.word8 tag <>         Builder.word8 nodeTag <>         Builder.byteString node <>         Builder.byteString eid <>         Builder.byteString serial <>-        Builder.word8 creation+        Builder.byteString creation termsToBinary (OtpErlangPort (E.Port nodeTag node eid creation)) =+    let tag =+            if (ByteString.length creation) == 4 then +                tagNewPortExt+            else+                tagPortExt in     ok $ Builder.toLazyByteString $-        Builder.word8 tagPortExt <>+        Builder.word8 tag <>         Builder.word8 nodeTag <>         Builder.byteString node <>         Builder.byteString eid <>-        Builder.word8 creation+        Builder.byteString creation termsToBinary (OtpErlangReference (E.Reference nodeTag node eid creation)) =     let length = (ByteString.length eid) `quot` 4 in     if length == 0 then@@ -673,14 +698,19 @@             Builder.word8 nodeTag <>             Builder.byteString node <>             Builder.byteString eid <>-            Builder.word8 creation+            Builder.byteString creation     else if length <= 65535 then+        let tag =+                if (ByteString.length creation) == 4 then +                    tagNewerReferenceExt+                else+                    tagNewReferenceExt in         ok $ Builder.toLazyByteString $-            Builder.word8 tagNewReferenceExt <>+            Builder.word8 tag <>             Builder.word16BE (fromIntegral length) <>             Builder.word8 nodeTag <>             Builder.byteString node <>-            Builder.word8 creation <>+            Builder.byteString creation <>             Builder.byteString eid     else         errorType $ OutputError "uint16 overflow"

@@ -5,7 +5,7 @@    MIT License -  Copyright (c) 2017 Michael Truog <mjtruog at protonmail dot com>+  Copyright (c) 2017-2019 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"),@@ -42,6 +42,6 @@     , node :: !ByteString     , id :: !ByteString     , serial :: !ByteString-    , creation :: !Word8+    , creation :: !ByteString     } deriving (Ord, Eq, Show) 

@@ -5,7 +5,7 @@    MIT License -  Copyright (c) 2017 Michael Truog <mjtruog at protonmail dot com>+  Copyright (c) 2017-2019 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"),@@ -41,6 +41,6 @@     { nodeTag :: !Word8     , node :: !ByteString     , id :: !ByteString-    , creation :: !Word8+    , creation :: !ByteString     } deriving (Ord, Eq, Show) 

@@ -5,7 +5,7 @@    MIT License -  Copyright (c) 2017 Michael Truog <mjtruog at protonmail dot com>+  Copyright (c) 2017-2019 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"),@@ -41,6 +41,6 @@     { nodeTag :: !Word8     , node :: !ByteString     , id :: !ByteString-    , creation :: !Word8+    , creation :: !ByteString     } deriving (Ord, Eq, Show)