1 files changed, 20 insertions, 7 deletions

diff --git a/server/src/Thermoprint/Server/API.hs b/server/src/Thermoprint/Server/API.hs
index 6a92caf..a1efb8f 100644
--- a/server/src/Thermoprint/Server/API.hs
+++ b/server/src/Thermoprint/Server/API.hs
@@ -1,6 +1,7 @@
-{-# LANGUAGE TypeOperators    #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE TemplateHaskell  #-}
+{-# LANGUAGE TypeOperators     #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Thermoprint.Server.API
        ( ProtoHandler, Handler
@@ -11,7 +12,8 @@ module Thermoprint.Server.API
 import Thermoprint.API hiding (JobId(..), DraftId(..))
 import qualified Thermoprint.API as API (JobId(..), DraftId(..))
 
-import Thermoprint.Server.Printer (Printer(..), Queue(..))
+import Thermoprint.Server.Printer
+import Thermoprint.Server.Database
 
 import Data.Set (Set)
 import qualified Data.Set as Set
@@ -26,6 +28,7 @@ import Servant.Server.Internal.Enter
 
 import Control.Monad.Logger
 import Control.Monad.Reader
+import Control.Monad.Trans.Resource
 import Control.Monad.Trans.Either
 import Control.Monad.IO.Class
 
@@ -40,7 +43,7 @@ import Data.Traversable (mapM)
 import Database.Persist
 import Database.Persist.Sql
 
-type ProtoHandler = ReaderT HandlerInput (LoggingT IO)
+type ProtoHandler = ReaderT HandlerInput (LoggingT (ResourceT IO))
 type Handler      = EitherT ServantErr ProtoHandler
 
 -- ^ Runtime configuration of our handlers
@@ -63,7 +66,7 @@ handlerNat printerMap = do
       , printers = printerMap
       }
     protoNat :: ProtoHandler :~> IO
-    protoNat = Nat (($ logFunc) . runLoggingT) . runReaderTNat handlerInput
+    protoNat = Nat runResourceT . Nat (($ logFunc) . runLoggingT) . runReaderTNat handlerInput
   return $ hoistNat protoNat
 
 thermoprintServer :: ServerT ThermoprintAPI Handler
@@ -79,6 +82,16 @@ thermoprintServer = listPrinters
     (<||>) = liftM2 (:<|>)
     infixr 9 <||>
 
+lookupPrinter :: Maybe PrinterId -> Handler Printer
+lookupPrinter pId = asks printers >>= maybePrinter' pId
+  where
+    maybePrinter' Nothing printerMap
+      | Map.null printerMap = left $ err501 { errBody = "No printers available" }
+      | otherwise = return . snd $ Map.findMin printerMap
+    maybePrinter (Just pId) printerMap
+      | Just printer <- Map.lookup pId printerMap = return printer
+      | otherwise = left $ err404 { errBody = "No such printer" }
+
 listPrinters :: Handler (Map PrinterId PrinterStatus)
 listPrinters = fmap toStatus <$> (mapM (liftIO . readTVarIO . queue) . printers =<< ask)
   where
@@ -86,7 +99,7 @@ listPrinters = fmap toStatus <$> (mapM (liftIO . readTVarIO . queue) . printers
     toStatus (Queue _ (Just id) _) = Busy . castId $ fromSqlKey id
 
 queueJob :: Maybe PrinterId -> Printout -> Handler API.JobId
-queueJob = return undefined
+queueJob pId printout = lift . fmap (castId' . unJobKey) . withReaderT sqlPool . addToQueue printout =<< lookupPrinter pId
 
 printerStatus :: PrinterId -> Handler PrinterStatus
 printerStatus = return undefined