packages feed

neptune-backend 0.1.1 → 0.1.2

raw patch · 8 files changed

+273/−158 lines, 8 filesdep +concurrent-extra

Dependencies added: concurrent-extra

Files

README.md view
@@ -10,6 +10,13 @@             threadDelay 1000000 ``` +## TODOs+* Support logging text, image value.+* Create project+* Register callback for the abort action from web console.+* Support system channels+* Get git information+ ## OpenAPI Auto-Generated http-client Bindings to Neptune Backend API  This library is intended to be imported qualified.
lib/Neptune.hs view
@@ -1,19 +1,28 @@-{--   Neptune Backend API+{-|+Module      : Neptune+Description : Neptune Client+Copyright   : (c) Jiasen Wu, 2020+License     : BSD-3-Clause -   No description provided (generated by Openapi Generator https://github.com/openapitools/openapi-generator)+This is a client library for <https://neptune.ai> -   OpenAPI Version: 3.0.1-   Neptune Backend API API version: 2.8-   Generated by OpenAPI Generator (https://openapi-generator.tech)--}+=== Example: -{-|-Module : Neptune+@+main = do+    -- Experiment 'sandbox' must be created from the Neptune dashboard+    withNept "jiasen/sandbox" $ \session experiment -> do+        forM_ [1..10::Int] $ \i -> do+            -- You can log a name-value pair.+            nlog experiment "counter" (fromIntegral (i * i) :: Double)+            threadDelay 1000000+@ -}  module Neptune   ( module Neptune.Client+  , module Neptune.Session   ) where  import           Neptune.Client+import           Neptune.Session
lib/Neptune/Channel.hs view
@@ -1,108 +1,80 @@+{-|+Module      : Neptune.Channel+Description : Neptune Client+Copyright   : (c) Jiasen Wu, 2020+License     : BSD-3-Clause+-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE RecordWildCards           #-} {-# LANGUAGE ScopedTypeVariables       #-}-{-# LANGUAGE StandaloneDeriving        #-}-{-# LANGUAGE TemplateHaskell           #-} module Neptune.Channel where +import           Control.Concurrent.Event  as E (isSet, set) import           Control.Lens-import           Data.Time.Clock           (UTCTime)-import           Data.Time.Clock.POSIX     (utcTimeToPOSIXSeconds)-import           Data.Typeable+import           Data.Typeable             (Proxy (..), cast) import           RIO                       hiding (Lens', (^.)) import qualified RIO.HashMap               as M  import qualified Neptune.Backend.API       as NBAPI import           Neptune.Backend.MimeTypes-import           Neptune.Backend.Model+import           Neptune.Backend.Model     hiding (Experiment) import           Neptune.Backend.ModelLens import           Neptune.Session -class (Typeable a, Show a) => NeptDataType a where-    neptChannelType :: Proxy a -> ChannelTypeEnum-    toNeptPoint     :: DataPoint a -> Point--data DataPoint a = DataPoint-    { _dpt_name      :: Text-    , _dpt_timestamp :: UTCTime-    , _dpt_value     :: a-    }-    deriving Show--data DataPointAny = forall a . NeptDataType a => DataPointAny (DataPoint a)-deriving instance Show DataPointAny--newtype DataChannel a = DataChannel Text-    deriving Show--data DataChannelAny = forall a . NeptDataType a => DataChannelAny (DataChannel a)-deriving instance Show DataChannelAny- data DataChannelWithData = forall a. NeptDataType a => DataChannelWithData (DataChannel a, [DataPoint a]) -type ChannelHashMap = TVar (HashMap Text DataChannelAny)--makeLenses ''DataPoint--dpt_name_A :: Lens' DataPointAny Text-dpt_name_A f (DataPointAny (DataPoint n t v)) =-    let set = (\n -> DataPointAny (DataPoint n t v))-     in set <$> f n--dpt_timestamp_A :: Lens' DataPointAny UTCTime-dpt_timestamp_A f (DataPointAny (DataPoint n t v)) =-    let set = (\t -> DataPointAny (DataPoint n t v))-     in set <$> f t-+-- | Background thread for transmission transmitter :: HasCallStack             => NeptuneSession-            -> ExperimentId-            -> TChan DataPointAny-            -> ChannelHashMap+            -> Experiment             -> IO ()-transmitter session@NeptuneSession{..} exp_id chan user_channels = sequence_ (repeat go)+transmitter session@NeptuneSession{..} Experiment{..} = go     where-        go = do dat <- atomically $ readTChanAtMost 10 chan+        go = do+            stop_flag <- E.isSet _exp_stop_flag+            dat <- atomically $+                    if stop_flag+                      then readTChanFull _exp_outbound_q+                      else readTChanAtMost 100 _exp_outbound_q+            send dat+            if not stop_flag+               then go+               else E.set _exp_transmitter_flag -                let dup           = Control.Lens.to (\a -> (a, a))-                    singleton     = Control.Lens.to (\a -> [a])-                    merge         = M.toList . foldl' (M.unionWith (++)) M.empty . map (uncurry M.singleton)-                    dat_with_name :: [(Text, [DataPointAny])]-                    dat_with_name = merge $ dat ^.. traverse . dup . alongside dpt_name_A singleton+        send dat = do+            let dup           = Control.Lens.to (\a -> (a, a))+                singleton     = Control.Lens.to (\a -> [a])+                merge         = M.toList . foldl' (M.unionWith (++)) M.empty . map (uncurry M.singleton)+                dat_with_name :: [(Text, [DataPointAny])]+                dat_with_name = merge $ dat ^.. traverse . dup . alongside dpt_name_A singleton -                chn_with_dat <- forM dat_with_name $ \(chn_name, dat) -> do-                    -- If channel doesn't exist, then we create one with-                    -- channel type from the first element.-                    chn <- case head dat of-                             DataPointAny d0 ->-                                 getOrCreateChannel-                                    (proxy d0)-                                    user_channels-                                    chn_name-                                    (createChannel session exp_id user_channels chn_name)+            chn_with_dat <- forM dat_with_name $ \(chn_name, dat) -> do+                -- If channel doesn't exist, then we create one with+                -- channel type from the first element.+                chn <- case head dat of+                         DataPointAny d0 ->+                             getOrCreateChannel+                                (proxy d0)+                                _exp_user_channels+                                chn_name+                                (createChannel session _exp_experiment_id chn_name) -                    case chn of-                      DataChannelAny chn -> do-                          let (errs, grouped) = gatherDataPoints (proxy chn) dat-                          -- TODO log properly-                          mapM_ print errs-                          return $ DataChannelWithData (chn, grouped)+                case chn of+                  DataChannelAny chn -> do+                      let (errs, grouped) = gatherDataPoints (proxy chn) dat+                      -- TODO log properly+                      mapM_ print errs+                      return $ DataChannelWithData (chn, grouped) -                sendChannel session exp_id chn_with_dat+            sendChannel session _exp_experiment_id chn_with_dat          proxy :: f a -> Proxy a         proxy _ = Proxy --instance NeptDataType Double where-    neptChannelType  _ = ChannelTypeEnum'Numeric-    toNeptPoint dat    = let t = floor $ utcTimeToPOSIXSeconds (dat ^. dpt_timestamp) * 1000-                             y = mkY{ yNumericValue = dat ^. dpt_value . re _Just }-                          in mkPoint t y-+-- | Create a neptune data channel. createChannel :: forall t. (NeptDataType t, HasCallStack)-              => NeptuneSession -> ExperimentId -> ChannelHashMap -> Text -> IO (DataChannel t)-createChannel NeptuneSession{..} exp_id user_channels chn_name = do+              => NeptuneSession -> ExperimentId -> Text -> IO (DataChannel t)+createChannel NeptuneSession{..} exp_id chn_name = do     -- call create channel api     let chn_type = neptChannelType  (Proxy :: Proxy t)     chn <- _neptune_dispatch $ NBAPI.createChannel@@ -110,25 +82,30 @@         (Accept MimeJSON)         (mkChannelParams chn_name chn_type)         exp_id-    let chn_new = DataChannel (chn ^. channelDTOIdL) :: DataChannel t-    -- add to `user_channels`-    atomically $ do-        mapping <- readTVar user_channels-        writeTVar user_channels (mapping & ix chn_name .~ (DataChannelAny chn_new))-    return chn_new+    return $ DataChannel (chn ^. channelDTOIdL) :: IO (DataChannel t) +-- | Get a neptune data channel. If the data channel doesn't exist yet,+-- a data channel will be created and added to the hashmap of current+-- user channels. getOrCreateChannel :: forall t. NeptDataType t-                   => Proxy t-                   -> ChannelHashMap-                   -> Text-                   -> IO (DataChannel t)+                   => Proxy t -- ^ dummy data type+                   -> ChannelHashMap -- ^ current user channels+                   -> Text -- ^ channel name+                   -> IO (DataChannel t) -- ^ creator                    -> IO DataChannelAny getOrCreateChannel _ user_channels chn_name creator = do     uc  <- readTVarIO user_channels     case uc ^? ix chn_name of-      Nothing -> DataChannelAny <$> creator+      Nothing -> do+        -- add to `user_channels`+        chn_new <- DataChannelAny <$> creator+        atomically $ do+            mapping <- readTVar user_channels+            writeTVar user_channels (mapping & ix chn_name .~ chn_new)+            return chn_new       Just x  -> return x +-- | Send a batch of data in their respective channel. sendChannel :: HasCallStack => NeptuneSession -> ExperimentId -> [DataChannelWithData] -> IO () sendChannel NeptuneSession{..} exp_id chn'value = do     errors <- _neptune_dispatch $ NBAPI.postChannelValues@@ -149,7 +126,8 @@         toChannelsValues (DataChannelWithData (DataChannel chn, dat)) =             mkInputChannelValues chn (map toNeptPoint dat) -+-- | Read at most 'n' items from the queue, with blocking read at the+-- first item. readTChanAtMost :: Int -> TChan a -> STM [a] readTChanAtMost n chan = do     -- blocking-read for the 1st elem@@ -158,6 +136,16 @@     vs <- sequence $ replicate (n - 1) (tryReadTChan chan)     return $ v0 : catMaybes vs +-- | Read all items from the queue+readTChanFull :: TChan a -> STM [a]+readTChanFull chan = do+    vs <- tryReadTChan chan+    case vs of+      Nothing -> return []+      Just v -> do+          vs <- readTChanFull chan+          return $ v : vs+ gatherDataPoints :: forall a. NeptDataType a                  => Proxy a                  -> [DataPointAny]@@ -165,5 +153,5 @@ gatherDataPoints _ dpa = partitionEithers $ map castData dpa     where         castData (DataPointAny d) = case cast d of-                                      Nothing -> Left "?? is not compatible for the channel"+                                      Nothing -> Left $ _dpt_name d <> " is not compatible for the channel"                                       Just o -> Right o
lib/Neptune/Client.hs view
@@ -1,15 +1,21 @@+{-|+Module      : Neptune.Client+Description : Neptune Client+Copyright   : (c) Jiasen Wu, 2020+License     : BSD-3-Clause+-} {-# LANGUAGE RecordWildCards     #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell     #-} module Neptune.Client where -import           Control.Concurrent        (ThreadId, forkIO, killThread)-import           Control.Lens+import           Control.Concurrent        (forkIO, killThread)+import           Control.Concurrent.Event  as E (new, set, waitTimeout)+import           Control.Lens              ((<&>), (^.)) import qualified Data.Text.Lazy            as TL import qualified Data.Text.Lazy.Encoding   as TL import           Data.Time.Clock           (getCurrentTime) import qualified Data.UUID                 as UUID (toText)-import           Data.UUID.V4              as UUID+import           Data.UUID.V4              as UUID (nextRandom) import qualified Network.HTTP.Client       as NH import qualified Network.HTTP.Client.TLS   as NH import           RIO                       hiding (Lens', (^.))@@ -29,26 +35,19 @@ import           Neptune.Utils  +-- | Experiment's hyper-parameter. When creating an experiment, you could+-- specify parameters to present in the web console. data Parameter = ExperimentParamS Text Text     | ExperimentParamD Text Double -data Experiment = Experiment-    { _exp_experiment_id :: ExperimentId-    , _exp_outbound_q    :: TChan DataPointAny-    , _exp_user_channels :: ChannelHashMap-    , _exp_transmitter   :: ThreadId-    }--makeLenses ''Experiment--+-- | Create an experiment createExperiment :: HasCallStack-                 => NeptuneSession-                 -> Maybe Text-                 -> Maybe Text-                 -> [Parameter]-                 -> [(Text, Text)]-                 -> [Text]+                 => NeptuneSession -- ^ Session+                 -> Maybe Text -- ^ Optional name (automatically assigned if Nothing)+                 -> Maybe Text -- ^ Optional description+                 -> [Parameter] -- ^ hyper-parameters+                 -> [(Text, Text)] -- ^ properties+                 -> [Text] -- ^ tags                  -> IO Experiment createExperiment session@NeptuneSession{..} name description params props tags = do     -- TODO support git_info@@ -70,8 +69,11 @@     let exp_id = ExperimentId (exp ^. experimentIdL)     chan <- newTChanIO     user_channels <- newTVarIO M.empty-    transmitter_thread <- forkIO $ transmitter session exp_id chan user_channels-    return $ Experiment exp_id chan user_channels transmitter_thread+    stop_flag <- E.new+    transmitter_flag <- E.new+    let exp = Experiment exp_id chan user_channels stop_flag transmitter_flag undefined+    transmitter_thread <- forkIO $ transmitter session exp+    return exp {_exp_transmitter = transmitter_thread}      where         _mkParameter (ExperimentParamS name value) = do@@ -81,14 +83,22 @@             _id <- UUID.toText <$> UUID.nextRandom             return $ mkParameter name ParameterTypeEnum'Double _id (tshow value) -nlog :: (HasCallStack, NeptDataType a) => Experiment -> Text -> a -> IO ()+-- | Log a key-value pair+nlog :: (HasCallStack, NeptDataType a)+     => Experiment -- ^ experiment+     -> Text -- ^ key+     -> a -- ^ value+     -> IO () nlog exp name value = do     now <- getCurrentTime     let chan = exp ^. exp_outbound_q         dat  = DataPointAny $ DataPoint name now value     atomically $ writeTChan chan dat -withNept :: Text -> (NeptuneSession -> Experiment -> IO a) -> IO a+-- | Run an action within a neptune session+withNept :: Text -- ^ \<namespace\>\/\<project_name\>+         -> (NeptuneSession -> Experiment -> IO a) -- ^ action+         -> IO a withNept project_qualified_name act = do     ses <- initNept project_qualified_name     exp <- createExperiment ses Nothing Nothing [] [] []@@ -102,7 +112,10 @@           teardownNept ses exp ExperimentState'Succeeded ""           return a -initNept :: HasCallStack => Text -> IO NeptuneSession+-- | Initialize a neptune session+initNept :: HasCallStack+         => Text -- ^ \<namespace\>\/\<project_name\>+         -> IO NeptuneSession initNept project_qualified_name = do     ct@ClientToken{..} <- decodeEnv >>= either throwString return @@ -116,8 +129,8 @@                     >=> handleMimeError      oauth_token <- dispatch  $ NBAPI.exchangeApiToken (Accept MimeJSON) (XNeptuneApiToken _ct_token)-    (refresh_thread, oauth_session) <- oauth2_setup (oauth_token ^. neptuneOauthTokenAccessTokenL)-                                                    (oauth_token ^. neptuneOauthTokenRefreshTokenL)+    (refresh_thread, oauth_session) <- oauth2Setup (oauth_token ^. neptuneOauthTokenAccessTokenL)+                                                   (oauth_token ^. neptuneOauthTokenRefreshTokenL)      -- TODO there is a chance that the access token gets invalid right after readMVar     let dispatch :: (HasCallStack, Produces req accept, MimeUnrender accept res, MimeType contentType)@@ -138,17 +151,26 @@         , _neptune_dispatch = dispatch         } -teardownNept :: NeptuneSession -> Experiment -> ExperimentState -> Text -> IO ()+-- | Teardown a neptune session+teardownNept :: NeptuneSession -- ^ session+             -> Experiment -- ^ experiment+             -> ExperimentState -- ^ completion state+             -> Text -- ^ completion message+             -> IO () teardownNept NeptuneSession{..} experiment state msg = do-    killThread $ experiment ^. exp_transmitter+    E.set (experiment ^. exp_stop_flag)+    -- wait at most 5 seconds+    done <- E.waitTimeout (experiment ^. exp_transmitter_flag) 5000000+    -- kill if timeout+    unless done $+        killThread $ experiment ^. exp_transmitter     killThread $ _neptune_oauth2_refresh -    _neptune_dispatch $ NBAPI.markExperimentCompleted+    _ <- _neptune_dispatch $ NBAPI.markExperimentCompleted         (ContentType MimeJSON)         (Accept MimeNoContent)         (mkCompletedExperimentParams state msg)         (experiment ^. exp_experiment_id) :: IO NoContent      return ()- 
lib/Neptune/OAuth.hs view
@@ -1,3 +1,9 @@+{-|+Module      : Neptune.OAuth+Description : Neptune Client+Copyright   : (c) Jiasen Wu, 2020+License     : BSD-3-Clause+-} {-# LANGUAGE TemplateHaskell #-} module Neptune.OAuth where @@ -19,16 +25,17 @@  data OAuth2Session = OAuth2Session     { _oas_client_id     :: Text-    , _oas_access_token  :: Text-    , _oas_refresh_token :: Text-    , _oas_expires_in    :: NominalDiffTime-    , _oas_refresh_url   :: Text+    , _oas_access_token  :: Text -- ^ access token for APIs+    , _oas_refresh_token :: Text -- ^ refresh token after expires+    , _oas_expires_in    :: NominalDiffTime -- ^ duration in which the access token is valid+    , _oas_refresh_url   :: Text -- ^ refresh url     }  makeLenses ''OAuth2Session -oauth2_setup :: Text -> Text -> IO (ThreadId, MVar OAuth2Session)-oauth2_setup access_token refresh_token = do+-- | Setup a background thread to refresh OAuth2 token.+oauth2Setup :: Text -> Text -> IO (ThreadId, MVar OAuth2Session)+oauth2Setup access_token refresh_token = do     let decoded = JWT.decode $ access_token         claims  = JWT.claims (decoded ^?! _Just)         issuer  = JWT.iss claims ^?! _Just & JWT.stringOrURIToText@@ -41,11 +48,11 @@         session = OAuth2Session client_name access_token refresh_token expires_in refresh_url      oauth_session_var <- newMVar session-    refresh_thread <- forkIO (oauth_refresher oauth_session_var)+    refresh_thread <- forkIO (oauthRefresher oauth_session_var)     return (refresh_thread, oauth_session_var) -oauth_refresher :: MVar OAuth2Session -> IO ()-oauth_refresher session_var = update >> oauth_refresher session_var+oauthRefresher :: MVar OAuth2Session -> IO ()+oauthRefresher session_var = update >> oauthRefresher session_var     where         update = do             session <- readMVar session_var
lib/Neptune/Session.hs view
@@ -1,14 +1,25 @@-{-# LANGUAGE DeriveGeneric   #-}-{-# LANGUAGE Rank2Types      #-}-{-# LANGUAGE TemplateHaskell #-}+{-|+Module      : Neptune.Session+Description : Neptune Client+Copyright   : (c) Jiasen Wu, 2020+License     : BSD-3-Clause+-}+{-# LANGUAGE DeriveGeneric             #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE Rank2Types                #-}+{-# LANGUAGE StandaloneDeriving        #-}+{-# LANGUAGE TemplateHaskell           #-} module Neptune.Session where  import           Control.Concurrent        (ThreadId)+import           Control.Concurrent.Event  as E (Event) import           Control.Lens-import           Control.Monad.Except+import           Control.Monad.Except      (MonadError (throwError)) import qualified Data.Aeson                as Aeson import           Data.Aeson.Lens import qualified Data.ByteString.Base64    as Base64+import           Data.Time.Clock           (UTCTime)+import           Data.Time.Clock.POSIX     (utcTimeToPOSIXSeconds) import qualified Network.HTTP.Client       as NH import           RIO                       hiding (Lens', (^.)) import qualified RIO.Text                  as T@@ -16,14 +27,16 @@  import           Neptune.Backend.Core import           Neptune.Backend.MimeTypes-import           Neptune.Backend.Model+import           Neptune.Backend.Model     hiding (Experiment, Parameter) import           Neptune.OAuth ++-- | Decoded client token data ClientToken = ClientToken-    { _ct_token       :: Text-    , _ct_api_address :: Text-    , _ct_api_url     :: Text-    , _ct_api_key     :: Text+    { _ct_token       :: Text -- ^ user secret+    , _ct_api_address :: Text -- ^ neptune api address+    , _ct_api_url     :: Text -- ^ neptune api address+    , _ct_api_key     :: Text -- ^ neptune api key (not used)     }     deriving (Generic, Show) @@ -45,13 +58,73 @@                   => NeptuneBackendRequest req contentType res accept                   -> IO res +-- | Neptune session. It contains all necessary information to communicate the+-- server. data NeptuneSession = NeptuneSession     { _neptune_http_manager   :: NH.Manager     , _neptune_client_token   :: ClientToken     , _neptune_config         :: NeptuneBackendConfig     , _neptune_oauth2         :: MVar OAuth2Session-    , _neptune_oauth2_refresh :: ThreadId-    , _neptune_project        :: ProjectWithRoleDTO-    , _neptune_dispatch       :: Dispatcher+    , _neptune_oauth2_refresh :: ThreadId -- ^ Background thread for updating OAuth2 token+    , _neptune_project        :: ProjectWithRoleDTO -- ^ Active project+    , _neptune_dispatch       :: Dispatcher -- ^ Dispatching function for http requests     }++data Experiment = Experiment+    { _exp_experiment_id    :: ExperimentId -- ^ Experiment Id+    , _exp_outbound_q       :: TChan DataPointAny -- ^ Output queue+    , _exp_user_channels    :: ChannelHashMap -- ^ Active output channels+    , _exp_stop_flag        :: E.Event -- ^ Event flag to indicate the end of the session+    , _exp_transmitter_flag :: E.Event -- ^ Event flag to indicate completion of transmission+    , _exp_transmitter      :: ThreadId -- ^ Background thread for transmission+    }++class (Typeable a, Show a) => NeptDataType a where+    neptChannelType :: Proxy a -> ChannelTypeEnum+    toNeptPoint     :: DataPoint a -> Point++-- | Type-safe data channel+newtype DataChannel a = DataChannel Text {- ^ Channel Id -}+    deriving Show++-- | Data channel of any type+data DataChannelAny = forall a . NeptDataType a => DataChannelAny (DataChannel a)+deriving instance Show DataChannelAny++-- | Hashmap of all channels in use+type ChannelHashMap = TVar (HashMap Text DataChannelAny)++-- | Type-safe data point+data DataPoint a = DataPoint+    { _dpt_name      :: Text+    , _dpt_timestamp :: UTCTime+    , _dpt_value     :: a+    }+    deriving Show++-- | Data point of any type+data DataPointAny = forall a . NeptDataType a => DataPointAny (DataPoint a)+deriving instance Show DataPointAny++makeLenses ''Experiment+makeLenses ''DataPoint++-- | Lens to get/set '_dpt_name' for 'DataPointAny'+dpt_name_A :: Lens' DataPointAny Text+dpt_name_A f (DataPointAny (DataPoint n t v)) =+    let set = (\n -> DataPointAny (DataPoint n t v))+     in set <$> f n++-- | Lens to get/set '_dpt_timestamp' for 'DataPointAny'+dpt_timestamp_A :: Lens' DataPointAny UTCTime+dpt_timestamp_A f (DataPointAny (DataPoint n t v)) =+    let set = (\t -> DataPointAny (DataPoint n t v))+     in set <$> f t++instance NeptDataType Double where+    neptChannelType  _ = ChannelTypeEnum'Numeric+    toNeptPoint dat    = let t = floor $ utcTimeToPOSIXSeconds (dat ^. dpt_timestamp) * 1000+                             y = mkY{ yNumericValue = dat ^. dpt_value . re _Just }+                          in mkPoint t y+ 
lib/Neptune/Utils.hs view
@@ -1,4 +1,9 @@-{-# LANGUAGE ViewPatterns #-}+{-|+Module      : Neptune.Utils+Description : Neptune Client+Copyright   : (c) Jiasen Wu, 2020+License     : BSD-3-Clause+-} module Neptune.Utils where  import qualified Data.ByteString.Lazy.Char8 as BSL@@ -7,8 +12,11 @@  import           Neptune.Backend.Client +-- | Unwrap the 'MimeResult a'. Raise an error if it indicates a failure. handleMimeError :: (Monad m, HasCallStack) => MimeResult a -> m a-handleMimeError (mimeResult -> Left e)  = let err_msg = mimeError e-                                              response = NH.responseBody $ mimeErrorResponse e-                                           in error (mimeError e ++ " " ++ BSL.unpack response)-handleMimeError (mimeResult -> Right r) = return r+handleMimeError result =+    case mimeResult result of+      Left e -> let err_msg = mimeError e+                    response = NH.responseBody $ mimeErrorResponse e+                in error (err_msg ++ " " ++ BSL.unpack response)+      Right r -> return r
neptune-backend.cabal view
@@ -1,9 +1,9 @@ cabal-version:  2.2 name:           neptune-backend-version:        0.1.1-synopsis:       Auto-generated neptune-backend API Client+version:        0.1.2+synopsis:       Neptune Client description:    .-                Client library for calling the Neptune Backend API API based on http-client.+                Client library for calling the Neptune API based on http-client.                 .                 Neptune Backend API API version: 2.8                 .@@ -62,6 +62,7 @@     , req     , envy     , uuid+    , concurrent-extra   other-modules:       Paths_neptune_backend   autogen-modules: