Skip to content

Commit

Permalink
fix: haskell client encode fix
Browse files Browse the repository at this point in the history
  • Loading branch information
@pratikmishra356 @Datron
pratikmishra356 authored and Datron committed Jan 22, 2025
1 parent 7f1b273 commit 48bdfaf
Show file tree
Hide file tree
Showing 2 changed files with 32 additions and 33 deletions.
37 changes: 18 additions & 19 deletions clients/haskell/hs-cac-client/src/Client.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,7 @@ module Client
import Data.Aeson
import Data.Functor (($>))
import Data.List (intercalate)
import Foreign.C.String (CString, newCAString, peekCAString)
import Foreign.C.String (CString, newCString, peekCString)
import Foreign.C.Types (CInt (CInt), CULong (..))
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc (malloc, free)
Expand Down Expand Up @@ -71,23 +71,23 @@ data MergeStrategy = MERGE | REPLACE deriving (Show, Eq, Ord, Enum)

cacStartPolling :: Tenant -> IO ()
cacStartPolling tenant =
newCAString tenant
newCString tenant
>>= newForeignPtr c_free_string
>>= flip withForeignPtr c_cac_poll

getError :: IO String
getError = c_last_error_message
>>= newForeignPtr c_free_string
>>= flip withForeignPtr peekCAString
>>= flip withForeignPtr peekCString

cleanup :: [Ptr a] -> IO ()
cleanup items = mapM free items $> ()

createCacClient:: Tenant -> Integer -> String -> IO (Either Error ())
createCacClient tenant frequency hostname = do
let duration = fromInteger frequency
cTenant <- newCAString tenant
cHostname <- newCAString hostname
cTenant <- newCString tenant
cHostname <- newCString hostname
resp <- c_new_cac_client cTenant duration cHostname
_ <- cleanup [cTenant, cHostname]
case resp of
Expand All @@ -100,8 +100,8 @@ createCacClientWithCacheProperties tenant frequency hostname cacheMaxCapacity ca
let cacheCapacity = fromInteger cacheMaxCapacity
let cacheTimeToLive = fromInteger cacheTTL
let cacheTimeToIdle = fromInteger cacheTTI
cTenant <- newCAString tenant
cHostname <- newCAString hostname
cTenant <- newCString tenant
cHostname <- newCString hostname
resp <- c_new_cac_client_with_cache_properties cTenant duration cHostname cacheCapacity cacheTimeToLive cacheTimeToIdle
_ <- cleanup [cTenant, cHostname]
case resp of
Expand All @@ -110,7 +110,7 @@ createCacClientWithCacheProperties tenant frequency hostname cacheMaxCapacity ca

getCacClient :: Tenant -> IO (Either Error (ForeignPtr CacClient))
getCacClient tenant = do
cTenant <- newCAString tenant
cTenant <- newCString tenant
cacClient <- c_get_cac_client cTenant
_ <- cleanup [cTenant]
if cacClient == nullPtr
Expand All @@ -120,18 +120,18 @@ getCacClient tenant = do
getFullConfigStateWithFilter :: ForeignPtr CacClient -> Maybe String -> Maybe [String] -> IO (Either Error Value)
getFullConfigStateWithFilter client mbFilters mbPrefix = do
cFilters <- case mbFilters of
Just filters -> newCAString filters
Just filters -> newCString filters
Nothing -> return nullPtr
cPrefix <- case mbPrefix of
Just prefix -> newCAString (intercalate "," prefix)
Just prefix -> newCString (intercalate "," prefix)
Nothing -> return nullPtr
config <- withForeignPtr client $ \clientPtr -> c_get_config clientPtr cFilters cPrefix
_ <- cleanup [cFilters]
if config == nullPtr
then Left <$> getError
else do
fptrConfig <- newForeignPtr c_free_string config
Right . toJSON <$> withForeignPtr fptrConfig peekCAString
Right . toJSON <$> withForeignPtr fptrConfig peekCString

getCacLastModified :: ForeignPtr CacClient -> IO (Either Error String)
getCacLastModified client = do
Expand All @@ -140,36 +140,35 @@ getCacLastModified client = do
then Left <$> getError
else do
fptrLastModified <- newForeignPtr c_free_string lastModified
Right <$> withForeignPtr fptrLastModified peekCAString
Right <$> withForeignPtr fptrLastModified peekCString

getResolvedConfigWithStrategy :: ForeignPtr CacClient -> String -> Maybe [String] -> MergeStrategy -> IO (Either Error Value)
getResolvedConfigWithStrategy client context mbKeys mergeStrat = do
cContext <- newCAString context
cMergeStrat <- newCAString (show mergeStrat)
cContext <- newCString context
cMergeStrat <- newCString (show mergeStrat)
cStrKeys <- case mbKeys of
Just keys -> newCAString (intercalate "|" keys)
Just keys -> newCString (intercalate "|" keys)
Nothing -> return nullPtr
overrides <- withForeignPtr client $ \clientPtr -> c_cac_get_resolved_config clientPtr cContext cStrKeys cMergeStrat
_ <- cleanup [cContext, cStrKeys]
if overrides == nullPtr
then Left <$> getError
else do
fptrOverrides <- newForeignPtr c_free_string overrides
Right . toJSON <$> withForeignPtr fptrOverrides peekCAString
Right . toJSON <$> withForeignPtr fptrOverrides peekCString

getDefaultConfig :: ForeignPtr CacClient -> Maybe [String] -> IO (Either Error Value)
getDefaultConfig client mbKeys = do
cStrKeys <- case mbKeys of
Just keys -> newCAString (intercalate "|" keys)
Just keys -> newCString (intercalate "|" keys)
Nothing -> return nullPtr
overrides <- withForeignPtr client $ \clientPtr -> c_cac_get_default_config clientPtr cStrKeys
_ <- cleanup [cStrKeys]
if overrides == nullPtr
then Left <$> getError
else do
fptrOverrides <- newForeignPtr c_free_string overrides
Right . toJSON <$> withForeignPtr fptrOverrides peekCAString
Right . toJSON <$> withForeignPtr fptrOverrides peekCString

getResolvedConfig :: ForeignPtr CacClient -> String -> Maybe [String] -> IO (Either Error Value)
getResolvedConfig client context mbKeys = getResolvedConfigWithStrategy client context mbKeys MERGE

28 changes: 14 additions & 14 deletions clients/haskell/hs-exp-client/src/Client.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -64,23 +64,23 @@ foreign import ccall unsafe "expt_get_running_experiments"

expStartPolling :: Tenant -> IO ()
expStartPolling tenant =
newCAString tenant
newCString tenant
>>= newForeignPtr c_free_string
>>= flip withForeignPtr c_start_polling_update

getError :: IO String
getError = c_last_error_message
>>= newForeignPtr c_free_string
>>= flip withForeignPtr peekCAString
>>= flip withForeignPtr peekCString

cleanup :: [Ptr a] -> IO ()
cleanup items = mapM free items $> ()

createExpClient:: Tenant -> Integer -> String -> IO (Either Error ())
createExpClient tenant frequency hostname = do
let duration = fromInteger frequency
cTenant <- newCAString tenant
cHostname <- newCAString hostname
cTenant <- newCString tenant
cHostname <- newCString hostname
resp <- c_new_expt_client cTenant duration cHostname
_ <- cleanup [cTenant, cHostname]
case resp of
Expand All @@ -89,7 +89,7 @@ createExpClient tenant frequency hostname = do

getExpClient :: Tenant -> IO (Either Error (ForeignPtr ExpClient))
getExpClient tenant = do
cTenant <- newCAString tenant
cTenant <- newCString tenant
cacClient <- c_get_expt_client cTenant
_ <- cleanup [cTenant]
if cacClient == nullPtr
Expand All @@ -98,48 +98,48 @@ getExpClient tenant = do

getApplicableVariants :: ForeignPtr ExpClient -> String -> Integer -> IO (Either Error String)
getApplicableVariants client query toss = do
context <- newCAString query
context <- newCString query
variants <- withForeignPtr client (\c -> c_get_applicable_variants c context (fromInteger toss))
_ <- cleanup [context]
if variants == nullPtr
then Left <$> getError
else do
fptrVariants <- newForeignPtr c_free_string variants
Right <$> withForeignPtr fptrVariants peekCAString
Right <$> withForeignPtr fptrVariants peekCString
-- pure $
-- case fromJSON variantVector of
-- Error s -> Left s
-- Success vec -> Right vec

getSatisfiedExperiments :: ForeignPtr ExpClient -> String -> Maybe String -> IO (Either Error Value)
getSatisfiedExperiments client query mbPrefix = do
context <- newCAString query
context <- newCString query
prefix <- case mbPrefix of
Just prefix -> newCAString prefix
Just prefix -> newCString prefix
Nothing -> return nullPtr
experiments <- withForeignPtr client $ \client -> c_get_satisfied_experiments client context prefix
_ <- cleanup [context]
if experiments == nullPtr
then Left <$> getError
else do
fptrExperiments <- newForeignPtr c_free_string experiments
Right . toJSON <$> withForeignPtr fptrExperiments peekCAString
Right . toJSON <$> withForeignPtr fptrExperiments peekCString

getFilteredSatisfiedExperiments :: ForeignPtr ExpClient -> Maybe String -> Maybe String -> IO (Either Error Value)
getFilteredSatisfiedExperiments client mbFilters mbPrefix = do
filters <- case mbFilters of
Just filters' -> newCAString filters'
Just filters' -> newCString filters'
Nothing -> return nullPtr
prefix <- case mbPrefix of
Just prefix' -> newCAString prefix'
Just prefix' -> newCString prefix'
Nothing -> return nullPtr
experiments <- withForeignPtr client $ \client -> c_get_filtered_satisfied_experiments client filters prefix
_ <- cleanup [filters]
if experiments == nullPtr
then Left <$> getError
else do
fptrExperiments <- newForeignPtr c_free_string experiments
Right . toJSON <$> withForeignPtr fptrExperiments peekCAString
Right . toJSON <$> withForeignPtr fptrExperiments peekCString

getRunningExperiments :: ForeignPtr ExpClient -> IO (Either Error Value)
getRunningExperiments client = do
Expand All @@ -148,4 +148,4 @@ getRunningExperiments client = do
then Left <$> getError
else do
fptrExperiments <- newForeignPtr c_free_string experiments
Right . toJSON <$> withForeignPtr fptrExperiments peekCAString
Right . toJSON <$> withForeignPtr fptrExperiments peekCString

0 comments on commit 48bdfaf

Please sign in to comment.