mu-grpc-server 0.3.0.0 → 0.4.0.0

raw patch · 4 files changed

+161/−128 lines, 4 filesdep +mu-grpc-serverdep ~asyncdep ~avrodep ~binaryPVP ok

version bump matches the API change (PVP)

Dependencies added: mu-grpc-server

Dependency ranges changed: async, avro, binary, bytestring, conduit, http2-grpc-types, mtl, mu-grpc-common, mu-protobuf, mu-rpc, mu-schema, sop-core, stm, stm-conduit, wai, warp, warp-grpc, warp-tls

API changes (from Hackage documentation)

Files

• exe/ExampleServer.hs +19/−0
• mu-grpc-server.cabal +40/−40
• src/ExampleServer.hs +0/−19
• src/Mu/GRpc/Server.hs +102/−69

@@ -0,0 +1,19 @@+{-# language DataKinds         #-}+{-# language OverloadedStrings #-}+{-# language TypeFamilies      #-}+module Main where++import           Mu.Adapter.ProtoBuf+import           Mu.GRpc.Server+import           Mu.Rpc.Examples+import           Mu.Schema++type instance AnnotatedSchema ProtoBufAnnotation QuickstartSchema+  = '[ 'AnnField "HelloRequest" "name" ('ProtoBufId 1 '[])+     , 'AnnField "HelloResponse" "message" ('ProtoBufId 1 '[])+     , 'AnnField "HiRequest" "number" ('ProtoBufId 1 '[]) ]++main :: IO ()+main = do+  putStrLn "running quickstart application"+  runGRpcApp msgProtoBuf 8080 quickstartServer

@@ -1,5 +1,5 @@ name:               mu-grpc-server-version:            0.3.0.0+version:            0.4.0.0 synopsis:           gRPC servers for Mu definitions description:   With @mu-grpc-server@ you can easily build gRPC servers for mu-haskell!@@ -23,25 +23,25 @@ library   exposed-modules:  Mu.GRpc.Server   build-depends:-      async-    , avro              >=0.5+      async             >=2.2     && < 3+    , avro              >=0.5.1   && <0.6     , base              >=4.12    && <5-    , binary-    , bytestring-    , conduit-    , http2-grpc-types-    , mtl-    , mu-grpc-common    >=0.3.0-    , mu-protobuf       >=0.3.0-    , mu-rpc            >=0.3.0-    , mu-schema         >=0.3.0-    , sop-core-    , stm-    , stm-conduit-    , wai-    , warp-    , warp-grpc         >=0.4.0.1-    , warp-tls+    , binary            >=0.8     && <0.9+    , bytestring        >=0.10    && <0.11+    , conduit           >=1.3.2   && <2+    , http2-grpc-types  >=0.5     && <0.6+    , mtl               >=2.2     && <3+    , mu-grpc-common    ==0.4.*+    , mu-protobuf       ==0.4.*+    , mu-rpc            ==0.4.*+    , mu-schema         ==0.3.*+    , sop-core          >=0.5     && <0.6+    , stm               >=2.5     && <3+    , stm-conduit       >=4       && <5+    , wai               >=3.2     && <4+    , warp              >=3.3     && <4+    , warp-grpc         >=0.4.0.1 && <0.5+    , warp-tls          >=3.2     && <4    hs-source-dirs:   src   default-language: Haskell2010@@ -49,28 +49,28 @@  executable grpc-example-server   main-is:          ExampleServer.hs-  other-modules:    Mu.GRpc.Server   build-depends:-      async-    , avro              >=0.4.7+      async             >=2.2     && < 3+    , avro              >=0.5.1   && <0.6     , base              >=4.12    && <5-    , binary-    , bytestring-    , conduit-    , http2-grpc-types-    , mtl-    , mu-grpc-common    >=0.3.0-    , mu-protobuf       >=0.3.0-    , mu-rpc            >=0.3.0-    , mu-schema         >=0.3.0-    , sop-core-    , stm-    , stm-conduit-    , wai-    , warp-    , warp-grpc         >=0.4.0.1-    , warp-tls+    , binary            >=0.8     && <0.9+    , bytestring        >=0.10    && <0.11+    , conduit           >=1.3.2   && <2+    , http2-grpc-types  >=0.5     && <0.6+    , mtl               >=2.2     && <3+    , mu-grpc-common    ==0.4.*+    , mu-grpc-server    ==0.4.*+    , mu-protobuf       ==0.4.*+    , mu-rpc            ==0.4.*+    , mu-schema         ==0.3.*+    , sop-core          >=0.5     && <0.6+    , stm               >=2.5     && <3+    , stm-conduit       >=4       && <5+    , wai               >=3.2     && <4+    , warp              >=3.3     && <4+    , warp-grpc         >=0.4.0.1 && <0.5+    , warp-tls          >=3.2     && <4 -  hs-source-dirs:   src+  hs-source-dirs:   exe   default-language: Haskell2010-  ghc-options:      -Wall+  ghc-options:      -Wall -fprint-explicit-kinds -fprint-explicit-foralls

@@ -1,19 +0,0 @@-{-# language DataKinds         #-}-{-# language OverloadedStrings #-}-{-# language TypeFamilies      #-}-module Main where--import           Mu.Adapter.ProtoBuf-import           Mu.GRpc.Server-import           Mu.Rpc.Examples-import           Mu.Schema--type instance AnnotatedSchema ProtoBufAnnotation QuickstartSchema-  = '[ 'AnnField "HelloRequest" "name" ('ProtoBufId 1 'True)-     , 'AnnField "HelloResponse" "message" ('ProtoBufId 1 'True)-     , 'AnnField "HiRequest" "number" ('ProtoBufId 1 'True) ]--main :: IO ()-main = do-  putStrLn "running quickstart application"-  runGRpcApp msgProtoBuf 8080 quickstartServer

@@ -51,7 +51,7 @@ import           Network.GRPC.HTTP2.Types           (GRPCStatus (..), GRPCStatusCode (..)) import           Network.GRPC.Server.Handlers.Trans import           Network.GRPC.Server.Wai            as Wai-import           Network.Wai                        (Application)+import           Network.Wai                        (Application, Request, requestHeaders) import           Network.Wai.Handler.Warp           (Port, Settings, run, runSettings) import           Network.Wai.Handler.WarpTLS        (TLSSettings, runTLS) @@ -65,20 +65,24 @@  -- | Run a Mu 'Server' on the given port. runGRpcApp-  :: ( KnownName name, GRpcServiceHandlers protocol ServerErrorIO chn services handlers )+  :: ( KnownName name+     , GRpcServiceHandlers ('Package ('Just name) services)+                           protocol ServerErrorIO chn services handlers )   => Proxy protocol   -> Port-  -> ServerT chn ('Package ('Just name) services) ServerErrorIO handlers+  -> ServerT chn () ('Package ('Just name) services) ServerErrorIO handlers   -> IO () runGRpcApp protocol port = runGRpcAppTrans protocol port id  -- | Run a Mu 'Server' on the given port. runGRpcAppTrans-  :: ( KnownName name, GRpcServiceHandlers protocol m chn services handlers )+  :: ( KnownName name+     , GRpcServiceHandlers ('Package ('Just name) services)+                           protocol m chn services handlers )   => Proxy protocol   -> Port   -> (forall a. m a -> ServerErrorIO a)-  -> ServerT chn ('Package ('Just name) services) m handlers+  -> ServerT chn () ('Package ('Just name) services) m handlers   -> IO () runGRpcAppTrans protocol port f svr = run port (gRpcAppTrans protocol f svr) @@ -86,11 +90,13 @@ -- --   Go to 'Network.Wai.Handler.Warp' to declare 'Settings'. runGRpcAppSettings-  :: ( KnownName name, GRpcServiceHandlers protocol m chn services handlers )+  :: ( KnownName name+     , GRpcServiceHandlers ('Package ('Just name) services)+                           protocol m chn services handlers )   => Proxy protocol   -> Settings   -> (forall a. m a -> ServerErrorIO a)-  -> ServerT chn ('Package ('Just name) services) m handlers+  -> ServerT chn () ('Package ('Just name) services) m handlers   -> IO () runGRpcAppSettings protocol st f svr = runSettings st (gRpcAppTrans protocol f svr) @@ -99,11 +105,13 @@ --   Go to 'Network.Wai.Handler.WarpTLS' to declare 'TLSSettings' --   and to 'Network.Wai.Handler.Warp' to declare 'Settings'. runGRpcAppTLS-  :: ( KnownName name, GRpcServiceHandlers protocol m chn services handlers )+  :: ( KnownName name+     , GRpcServiceHandlers ('Package ('Just name) services)+                           protocol m chn services handlers )   => Proxy protocol   -> TLSSettings -> Settings   -> (forall a. m a -> ServerErrorIO a)-  -> ServerT chn ('Package ('Just name) services) m handlers+  -> ServerT chn () ('Package ('Just name) services) m handlers   -> IO () runGRpcAppTLS protocol tls st f svr = runTLS tls st (gRpcAppTrans protocol f svr) @@ -113,9 +121,11 @@ --   for example, @wai-routes@, or you can add middleware --   from @wai-extra@, among others. gRpcApp-  :: ( KnownName name, GRpcServiceHandlers protocol ServerErrorIO chn services handlers )+  :: ( KnownName name+     , GRpcServiceHandlers ('Package ('Just name) services)+                           protocol ServerErrorIO chn services handlers )   => Proxy protocol-  -> ServerT chn ('Package ('Just name) services) ServerErrorIO handlers+  -> ServerT chn () ('Package ('Just name) services) ServerErrorIO handlers   -> Application gRpcApp protocol = gRpcAppTrans protocol id @@ -125,10 +135,12 @@ --   for example, @wai-routes@, or you can add middleware --   from @wai-extra@, among others. gRpcAppTrans-  :: ( KnownName name, GRpcServiceHandlers protocol m chn services handlers )+  :: ( KnownName name+     , GRpcServiceHandlers ('Package ('Just name) services)+                           protocol m chn services handlers )   => Proxy protocol   -> (forall a. m a -> ServerErrorIO a)-  -> ServerT chn ('Package ('Just name) services) m handlers+  -> ServerT chn () ('Package ('Just name) services) m handlers   -> Application gRpcAppTrans protocol f svr   = Wai.grpcApp [uncompressed, gzip]@@ -136,54 +148,68 @@  gRpcServerHandlers   :: forall name services handlers m protocol chn.-     ( KnownName name, GRpcServiceHandlers protocol m chn services handlers )+     ( KnownName name+     , GRpcServiceHandlers ('Package ('Just name) services)+                           protocol m chn services handlers )   => Proxy protocol   -> (forall a. m a -> ServerErrorIO a)-  -> ServerT chn ('Package ('Just name) services) m handlers+  -> ServerT chn () ('Package ('Just name) services) m handlers   -> [ServiceHandler]-gRpcServerHandlers pr f (Services svr) = gRpcServiceHandlers f pr packageName svr+gRpcServerHandlers pr f (Services svr)+  = gRpcServiceHandlers f (Proxy @('Package ('Just name) services)) pr packageName svr   where packageName = BS.pack (nameVal (Proxy @name)) -class GRpcServiceHandlers (p :: GRpcMessageProtocol) (m :: Type -> Type)+class GRpcServiceHandlers (fullP :: Package snm mnm anm (TypeRef snm))+                          (p :: GRpcMessageProtocol) (m :: Type -> Type)                           (chn :: ServiceChain snm)-                          (ss :: [Service snm mnm anm]) (hs :: [[Type]]) where+                          (ss :: [Service snm mnm anm (TypeRef snm)]) (hs :: [[Type]]) where   gRpcServiceHandlers :: (forall a. m a -> ServerErrorIO a)-                      -> Proxy p -> ByteString-                      -> ServicesT chn ss m hs -> [ServiceHandler]+                      -> Proxy fullP -> Proxy p -> ByteString+                      -> ServicesT chn () ss m hs -> [ServiceHandler] -instance GRpcServiceHandlers p m chn '[] '[] where-  gRpcServiceHandlers _ _ _ S0 = []-instance ( KnownName name, GRpcMethodHandlers p m chn (MappingRight chn name) methods h-         , GRpcServiceHandlers p m chn rest hs )-         => GRpcServiceHandlers p m chn ('Service name anns methods ': rest) (h ': hs) where-  gRpcServiceHandlers f pr packageName (svr :<&>: rest)-    =  gRpcMethodHandlers f pr packageName serviceName svr-    ++ gRpcServiceHandlers f pr packageName rest+instance GRpcServiceHandlers fullP p m chn '[] '[] where+  gRpcServiceHandlers _ _ _ _ S0 = []+instance ( KnownName name+         , GRpcMethodHandlers fullP ('Service name methods)+                              p m chn (MappingRight chn name) methods h+         , GRpcServiceHandlers fullP p m chn rest hs )+         => GRpcServiceHandlers fullP p m chn ('Service name methods ': rest) (h ': hs) where+  gRpcServiceHandlers f pfullP pr packageName (svr :<&>: rest)+    =  gRpcMethodHandlers f pfullP (Proxy @('Service name methods)) pr+                          packageName serviceName svr+    ++ gRpcServiceHandlers f pfullP pr packageName rest     where serviceName = BS.pack (nameVal (Proxy @name))  -class GRpcMethodHandlers (p :: GRpcMessageProtocol) (m :: Type -> Type)+class GRpcMethodHandlers (fullP :: Package snm mnm anm (TypeRef snm))+                         (fullS :: Service snm mnm anm (TypeRef snm))+                         (p :: GRpcMessageProtocol) (m :: Type -> Type)                          (chn :: ServiceChain snm) (inh :: Type)-                         (ms :: [Method snm mnm anm]) (hs :: [Type]) where+                         (ms :: [Method snm mnm anm (TypeRef snm)]) (hs :: [Type]) where   gRpcMethodHandlers :: (forall a. m a -> ServerErrorIO a)-                     -> Proxy p -> ByteString -> ByteString-                     -> HandlersT chn inh ms m hs -> [ServiceHandler]+                     -> Proxy fullP -> Proxy fullS -> Proxy p -> ByteString -> ByteString+                     -> HandlersT chn () inh ms m hs -> [ServiceHandler] -instance GRpcMethodHandlers p m chn inh '[] '[] where-  gRpcMethodHandlers _ _ _ _ H0 = []+instance GRpcMethodHandlers fullP fullS p m chn inh '[] '[] where+  gRpcMethodHandlers _ _ _ _ _ _ H0 = [] instance ( KnownName name, MkRPC p+         , ReflectRpcInfo fullP fullS ('Method name args r)          , GRpcMethodHandler p m args r h-         , GRpcMethodHandlers p m chn () rest hs)-         => GRpcMethodHandlers p m chn () ('Method name anns args r ': rest) (h ': hs) where-  gRpcMethodHandlers f pr p s (h :<||>: rest)-    = gRpcMethodHandler f pr (Proxy @args) (Proxy @r) (mkRPC pr p s methodName) (h ())-      : gRpcMethodHandlers f pr p s rest+         , GRpcMethodHandlers fullP fullS p m chn () rest hs)+         => GRpcMethodHandlers fullP fullS p m chn ()+                               ('Method name args r ': rest) (h ': hs) where+  gRpcMethodHandlers f pfullP pfullS pr p s (Hmore _ _ h rest)+    = gRpcMethodHandler f pr (Proxy @args) (Proxy @r) (mkRPC pr p s methodName)+                        (\req -> h (reflectInfo (requestHeaders req)) ())+      : gRpcMethodHandlers f pfullP pfullS pr p s rest     where methodName = BS.pack (nameVal (Proxy @name))+          reflectInfo hdrs+            = reflectRpcInfo pfullP pfullS (Proxy @('Method name args r)) hdrs () -class GRpcMethodHandler p m args r h where+class GRpcMethodHandler p m (args :: [Argument snm anm (TypeRef snm)]) r h where   gRpcMethodHandler :: (forall a. m a -> ServerErrorIO a)                     -> Proxy p -> Proxy args -> Proxy r-                    -> RPCTy p -> h -> ServiceHandler+                    -> RPCTy p -> (Request -> h) -> ServiceHandler  -- | Turns a 'Conduit' working on 'ServerErrorIO' --   into any other base monad which supports 'IO',@@ -276,7 +302,7 @@ instance (MonadIO m, GRPCInput (RPCTy p) (), GRPCOutput (RPCTy p) ())          => GRpcMethodHandler p m '[ ] 'RetNothing (m ()) where   gRpcMethodHandler f _ _ _ rpc h-    = unary @m @_ @() @() (raiseErrors . f) rpc (\_ _ -> h)+    = unary @m @_ @() @() (raiseErrors . f) rpc (\req _ -> h req)  ----- @@ -284,7 +310,8 @@          => GRpcMethodHandler p m '[ ] ('RetSingle rref) (m r) where   gRpcMethodHandler f _ _ _ rpc h     = unary @m @_ @() @(GRpcOWTy p rref r)-            (raiseErrors . f) rpc (\_ _ -> buildGRpcOWTy (Proxy @p) (Proxy @rref) <$> h)+            (raiseErrors . f) rpc+            (\req _ -> buildGRpcOWTy (Proxy @p) (Proxy @rref) <$> h req)  ----- @@ -293,13 +320,13 @@                               (ConduitT r Void m () -> m ()) where   gRpcMethodHandler f _ _ _ rpc h     = serverStream @m @_ @() @(GRpcOWTy p rref r) (raiseErrors . f) rpc sstream-    where sstream :: req -> ()+    where sstream :: Request -> ()                   -> m ((), ServerStream m (GRpcOWTy p rref r) ())-          sstream _ _ = do+          sstream req _ = do             -- Variable to connect input and output             var <- liftIO newEmptyTMVarIO :: m (TMVar (Maybe r))             -- Start executing the handler-            promise <- liftIO $ async (raiseErrors $ f (h (toTMVarConduit var)))+            promise <- liftIO $ async (raiseErrors $ f (h req (toTMVarConduit var)))             -- Return the information             let readNext _                   = do nextOutput <- liftIO $ atomically $ takeTMVar var@@ -312,38 +339,39 @@ -----  instance (MonadIO m, GRpcInputWrapper p vref v, GRPCOutput (RPCTy p) ())-         => GRpcMethodHandler p m '[ 'ArgSingle aname anns vref ] 'RetNothing (v -> m ()) where+         => GRpcMethodHandler p m '[ 'ArgSingle aname vref ] 'RetNothing (v -> m ()) where   gRpcMethodHandler f _ _ _ rpc h     = unary @m @_ @(GRpcIWTy p vref v) @()-            (raiseErrors . f) rpc (\_ -> h . unGRpcIWTy (Proxy @p) (Proxy @vref))+            (raiseErrors . f) rpc+            (\req -> h req . unGRpcIWTy (Proxy @p) (Proxy @vref))  -----  instance (MonadIO m, GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r)-         => GRpcMethodHandler p m '[ 'ArgSingle aname anns vref ] ('RetSingle rref) (v -> m r) where+         => GRpcMethodHandler p m '[ 'ArgSingle aname vref ] ('RetSingle rref) (v -> m r) where   gRpcMethodHandler f _ _ _ rpc h     = unary @m @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r)             (raiseErrors . f) rpc-            (\_ -> (buildGRpcOWTy (Proxy @p) (Proxy @rref) <$>)-                   . h-                   . unGRpcIWTy (Proxy @p) (Proxy @vref))+            (\req -> (buildGRpcOWTy (Proxy @p) (Proxy @rref) <$>)+                     . h req+                     . unGRpcIWTy (Proxy @p) (Proxy @vref))  -----  instance (GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r, MonadIO m)-         => GRpcMethodHandler p m '[ 'ArgSingle aname anns vref ] ('RetStream rref)+         => GRpcMethodHandler p m '[ 'ArgSingle aname vref ] ('RetStream rref)                               (v -> ConduitT r Void m () -> m ()) where   gRpcMethodHandler f _ _ _ rpc h     = serverStream @m @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r)                    (raiseErrors . f) rpc sstream-    where sstream :: req -> GRpcIWTy p vref v+    where sstream :: Request -> GRpcIWTy p vref v                   -> m ((), ServerStream m (GRpcOWTy p rref r) ())-          sstream _ v = do+          sstream req v = do             -- Variable to connect input and output             var <- liftIO newEmptyTMVarIO :: m (TMVar (Maybe r))             -- Start executing the handler             let v' = unGRpcIWTy (Proxy @p) (Proxy @vref) v-            promise <- liftIO $ async (raiseErrors $ f (h v' (toTMVarConduit var)))+            promise <- liftIO $ async (raiseErrors $ f (h req v' (toTMVarConduit var)))             -- Return the information             let readNext _                   = do nextOutput <- liftIO $ atomically $ takeTMVar var@@ -356,19 +384,19 @@ -----  instance (MonadIO m, GRpcInputWrapper p vref v, GRPCOutput (RPCTy p) (), MonadIO m)-         => GRpcMethodHandler p m '[ 'ArgStream aname anns vref ] 'RetNothing+         => GRpcMethodHandler p m '[ 'ArgStream aname vref ] 'RetNothing                               (ConduitT () v m () -> m ()) where   gRpcMethodHandler f _ _ _ rpc h     = clientStream @m @_ @(GRpcIWTy p vref v) @()                    (raiseErrors . f) rpc cstream-    where cstream :: req+    where cstream :: Request                   -> m ((), ClientStream m (GRpcIWTy p vref v) () ())-          cstream _ = do+          cstream req = do             -- Create a new TMChan             chan <- liftIO newTMChanIO :: m (TMChan v)             let producer = sourceTMChan @m chan             -- Start executing the handler in another thread-            promise <- liftIO $ async (raiseErrors $ f (h producer))+            promise <- liftIO $ async (raiseErrors $ f (h req producer))             -- Build the actual handler             let cstreamHandler _ newInput                   = liftIO $ atomically $@@ -381,20 +409,23 @@ -----  instance (MonadIO m, GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r, MonadIO m)-         => GRpcMethodHandler p m '[ 'ArgStream aname anns vref ] ('RetSingle rref)+         => GRpcMethodHandler p m '[ 'ArgStream aname vref ] ('RetSingle rref)                               (ConduitT () v m () -> m r) where   gRpcMethodHandler f _ _ _ rpc h     = clientStream @m @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r)                    (raiseErrors . f) rpc cstream-    where cstream :: req+    where cstream :: Request                   -> m ((), ClientStream m (GRpcIWTy p vref v)                         (GRpcOWTy p rref r) ())-          cstream _ = do+          cstream req = do             -- Create a new TMChan             chan <- liftIO newTMChanIO :: m (TMChan v)             let producer = sourceTMChan @m chan             -- Start executing the handler in another thread-            promise <- liftIO $ async (raiseErrors $ buildGRpcOWTy (Proxy @p) (Proxy @rref) <$> f (h producer))+            promise <- liftIO $ async+              (raiseErrors+                 $ buildGRpcOWTy (Proxy @p) (Proxy @rref)+                 <$> f (h req producer))             -- Build the actual handler             let cstreamHandler _ newInput                   = liftIO $ atomically $@@ -407,20 +438,22 @@ -----  instance (GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r, MonadIO m)-         => GRpcMethodHandler p m '[ 'ArgStream aname anns vref ] ('RetStream rref)+         => GRpcMethodHandler p m '[ 'ArgStream aname vref ] ('RetStream rref)                               (ConduitT () v m () -> ConduitT r Void m () -> m ()) where   gRpcMethodHandler f _ _ _ rpc h     = generalStream @m @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r)                     (raiseErrors . f) rpc bdstream-    where bdstream :: req -> m ( (), IncomingStream m (GRpcIWTy p vref v) ()-                               , (), OutgoingStream m (GRpcOWTy p rref r) () )-          bdstream _ = do+    where bdstream :: Request+                   -> m ( (), IncomingStream m (GRpcIWTy p vref v) ()+                        , (), OutgoingStream m (GRpcOWTy p rref r) () )+          bdstream req = do             -- Create a new TMChan and a new variable             chan <- liftIO newTMChanIO :: m (TMChan v)             let producer = sourceTMChan @m chan             var <- liftIO newEmptyTMVarIO :: m (TMVar (Maybe r))             -- Start executing the handler-            promise <- liftIO $ async (raiseErrors $ f $ h producer (toTMVarConduit var))+            promise <- liftIO $ async+              (raiseErrors $ f $ h req producer (toTMVarConduit var))             -- Build the actual handler             let cstreamHandler _ newInput                   = liftIO $ atomically $