Backtest driver fixed

robocom-zero.cabal

@@ -26,7 +26,7 @@ library
                      , ATrade.Quotes
                      , ATrade.Quotes.QHP
                      , ATrade.Quotes.QTIS
---                     , ATrade.Driver.Backtest
+                     , ATrade.Driver.Backtest
                      , ATrade.Driver.Junction
                      , ATrade.Driver.Junction.Types
                      , ATrade.Driver.Junction.QuoteThread
@@ -76,6 +76,9 @@ library
                      , co-log
                      , text-show
                      , unliftio
+                     , conduit
+                     , split
+                     , cassava
                      
   default-language:    Haskell2010
   other-modules:       ATrade.Exceptions

src/ATrade/Driver/Backtest.hs

@@ -13,59 +13,101 @@ module ATrade.Driver.Backtest (
   backtestMain
 ) where
 
-import           ATrade.Driver.Types      (InitializationCallback,
+import           ATrade.Driver.Junction.Types (StrategyDescriptor (StrategyDescriptor),
-                                           StrategyInstanceParams (..))
+                                               StrategyDescriptorE (StrategyDescriptorE),
-import           ATrade.Exceptions
+                                               TickerConfig, confStrategy,
-import           ATrade.Quotes
+                                               confTickers, eventCallback,
-import           ATrade.Quotes.Finam      as QF
+                                               strategyBaseName, tickerId,
-import           ATrade.Quotes.QTIS
+                                               timeframe)
-import           ATrade.RoboCom.Monad     (Event (..), EventCallback,
+import           ATrade.Exceptions            (RoboComException (UnableToLoadConfig, UnableToLoadFeed))
-                                           MonadRobot (..),
+import           ATrade.Logging               (Message, Severity (Error, Trace),
+                                               fmtMessage, logWith)
+import           ATrade.Quotes.QTIS           (TickerInfo (tiLotSize, tiTickSize),
+                                               qtisGetTickersInfo)
+import           ATrade.RoboCom.ConfigStorage (ConfigStorage (loadConfig))
+import           ATrade.RoboCom.Monad         (Event (..), MonadRobot (..),
                                                StrategyEnvironment (..),
-                                           appendToLog, seBars, seLastTimestamp)
+                                               appendToLog, seLastTimestamp)
-import           ATrade.RoboCom.Positions
+import           ATrade.RoboCom.Types         (BarSeries (..),
-import           ATrade.RoboCom.Types     (BarSeries (..), Bars, InstrumentParameters (InstrumentParameters),
+                                               BarSeriesId (BarSeriesId), Bars,
-                                           Ticker (..), Timeframe (..))
+                                               InstrumentParameters (InstrumentParameters),
-import           ATrade.Types
+                                               Ticker (..))
-import           Conduit                  (awaitForever, runConduit, yield,
+import           ATrade.Types                 (Bar (Bar, barHigh, barLow, barOpen, barSecurity, barTimestamp),
-                                           (.|))
+                                               BarTimeframe (BarTimeframe),
-import           Control.Exception.Safe
+                                               Operation (Buy),
-import           Control.Lens             hiding (ix, (<|), (|>))
+                                               Order (orderAccountId, orderId, orderOperation, orderPrice, orderQuantity, orderSecurity, orderSignalId),
+                                               OrderId,
+                                               OrderPrice (Limit, Market),
+                                               OrderState (Cancelled, Executed, Submitted),
+                                               Price, TickerId, Trade (..),
+                                               fromDouble)
+import           Colog                        (LogAction, (>$<))
+import           Colog.Actions                (logTextStdout)
+import           Conduit                      (ConduitT, Void, awaitForever,
+                                               runConduit, yield, (.|))
+import           Control.Exception.Safe       (catchAny, throw)
+import           Control.Lens                 (makeLenses, use, (%=), (+=),
+                                               (.=), (^.))
 import           Control.Monad.ST             (runST)
-import           Control.Monad.State
+import           Control.Monad.State          (MonadIO, MonadPlus (mzero),
-import           Data.Aeson               (FromJSON (..), Value (..), decode)
+                                               MonadState, MonadTrans (lift),
+                                               State, StateT (StateT),
+                                               execState, forM_, gets, when)
+import           Data.Aeson                   (FromJSON (..), Value (..),
+                                               decode)
 import           Data.Aeson.Types             (parseMaybe)
+import qualified Data.ByteString              as B
+import qualified Data.ByteString.Char8        as B8
 import           Data.ByteString.Lazy         (readFile, toStrict)
-import           Data.Default
+import qualified Data.ByteString.Lazy         as BL
+import           Data.Csv                     (FromField (parseField),
+                                               FromRecord (parseRecord),
+                                               HasHeader (HasHeader), (.!))
+import qualified Data.Csv                     as Csv
+import           Data.Default                 (Default (def))
 import           Data.HashMap.Strict          (lookup)
+import           Data.IORef                   (newIORef)
 import           Data.List                    (partition)
+import qualified Data.List                    as L
+import           Data.List.NonEmpty           (NonEmpty ((:|)))
 import           Data.List.Split              (splitOn)
 import qualified Data.Map.Strict              as M
 import           Data.Sequence                (Seq (..), (<|), (|>))
 import qualified Data.Sequence                as Seq
 import           Data.STRef                   (newSTRef, readSTRef, writeSTRef)
 import qualified Data.Text                    as T
+import           Data.Text.Encoding           (decodeUtf8)
 import           Data.Text.IO                 (putStrLn)
 import qualified Data.Text.Lazy               as TL
+import           Data.Time                    (defaultTimeLocale, parseTimeM)
 import           Data.Time.Calendar           (fromGregorian)
-import           Data.Time.Clock          (DiffTime, UTCTime (..))
+import           Data.Time.Clock              (UTCTime (..), addUTCTime)
 import           Data.Vector                  ((!), (!?), (//))
 import qualified Data.Vector                  as V
-import           Options.Applicative      hiding (Success)
+import           Dhall                        (FromDhall, auto, input)
-import           Prelude                  hiding (lookup, putStrLn, readFile)
+import           Options.Applicative          (Alternative (some), Parser,
+                                               ReadM, eitherReader, execParser,
+                                               fullDesc, header, helper, info,
+                                               long, metavar, option, short,
+                                               strOption)
+import           Prelude                      hiding (log, lookup, putStrLn,
+                                               readFile)
 import           Safe                         (headMay)
-import           System.ZMQ4              hiding (Event)
+import           System.IO                    (IOMode (ReadMode), withFile)
+import           System.ZMQ4                  (withContext)
 
 data Feed = Feed TickerId FilePath
   deriving (Show, Eq)
 
 data Params = Params {
+  strategyBasename   :: String,
   strategyConfigFile :: FilePath,
   qtisEndpoint       :: String,
   paramsFeeds        :: [Feed]
 } deriving (Show, Eq)
 
 data BacktestState c s = BacktestState {
+  _descriptor          :: StrategyDescriptor c s,
   _cash                :: Double,
   _robotState          :: s,
   _robotParams         :: c,
@@ -75,101 +117,135 @@ data BacktestState c s = BacktestState {
   _tradesLog           :: [Trade],
   _orderIdCounter      :: Integer,
   _pendingTimers       :: [UTCTime],
-  _logs                :: [T.Text]
+  _logs                :: [T.Text],
+  _barsMap             :: M.Map BarSeriesId BarSeries,
+  _availableTickers    :: NonEmpty BarSeriesId
 }
 
 makeLenses ''BacktestState
 
+data Row = Row {
+  rowTicker    :: T.Text,
+  rowTimeframe :: Int,
+  rowTime      :: UTCTime,
+  rowOpen      :: Price,
+  rowHigh      :: Price,
+  rowLow       :: Price,
+  rowClose     :: Price,
+  rowVolume    :: Integer
+} deriving (Show, Eq)
+
+instance FromField Price where
+  parseField s = fromDouble <$> (parseField s :: Csv.Parser Double)
+
+instance FromRecord Row where
+  parseRecord v
+    | length v == 9 = do
+      tkr <- v .! 0
+      tf <- v .! 1
+      date <- v .! 2
+      time <- v .! 3
+      dt <- addUTCTime (-3 * 3600) <$> parseDt date time
+      open <- v .! 4
+      high <- v .! 5
+      low <- v .! 6
+      close <- v .! 7
+      vol <- v .! 8
+      return $ Row tkr tf dt open high low close vol
+    | otherwise     = mzero
+    where
+      parseDt :: B.ByteString -> B.ByteString -> Csv.Parser UTCTime
+      parseDt d t = case parseTimeM True defaultTimeLocale "%Y%m%d %H%M%S" $ B8.unpack d ++ " " ++ B8.unpack t of
+        Just dt -> return dt
+        Nothing -> fail "Unable to parse date/time"
+
+parseQuotes :: B.ByteString -> Maybe [Row]
+parseQuotes csvData = case Csv.decode HasHeader $ BL.fromStrict csvData of
+  Left _  -> Nothing
+  Right d -> Just $ V.toList d
+
 paramsParser :: Parser Params
 paramsParser = Params
   <$> strOption (
-      long "config" <> short 'c'
+      long "strategy-name" <> short 'n')
-    )
+  <*> strOption (
+      long "config" <> short 'c')
   <*> strOption
     ( long "qtis" <> short 'q' <> metavar "ENDPOINT/ID")
   <*> some (option feedArgParser (
-      long "feed" <> short 'f'
+      long "feed" <> short 'f'))
-    ))
 
 feedArgParser :: ReadM Feed
 feedArgParser = eitherReader (\s -> case splitOn ":" s of
   [tid, fpath] -> Right $ Feed (T.pack tid) fpath
   _            -> Left $ "Unable to parse feed id: " ++ s)
 
-backtestMain :: (FromJSON c, StateHasPositions s) => DiffTime -> s -> EventCallback c s -> IO ()
+logger :: (MonadIO m) => LogAction m Message
-backtestMain _dataDownloadDelta defaultState callback = do
+logger = fmtMessage >$< logTextStdout
-  params <- execParser opts
-  (tickerList, config) <- loadStrategyConfig params
 
-  let instanceParams = StrategyInstanceParams {
+backtestMain :: M.Map T.Text StrategyDescriptorE -> IO ()
-    strategyInstanceId = "foo",
+backtestMain descriptors = do
-    strategyAccount = "foo",
+  params <- execParser opts
-    strategyVolume = 1,
+  let log = logWith logger
-    tickers = tickerList,
+  let strategyName = T.pack $ strategyBasename params
-    strategyQTISEp = Nothing }
 
   feeds <- loadFeeds (paramsFeeds params)
 
-  bars <- makeBars (T.pack $ qtisEndpoint params) tickerList
+  case M.lookup strategyName descriptors of
-
+    Just (StrategyDescriptorE desc) -> flip catchAny (\e -> log Error "Backtest" $ "Exception: " <> (T.pack . show $ e)) $
-  runBacktestDriver feeds config bars
+      runBacktestDriver desc feeds params
+    Nothing -> log Error "Backtest" $ "Can't find strategy: " <> strategyName
   where
     opts = info (helper <*> paramsParser)
       ( fullDesc <> header "ATrade strategy backtesting framework" )
 
-    makeBars :: T.Text -> [Ticker] -> IO (M.Map TickerId BarSeries)
+    makeBars :: T.Text -> [TickerConfig] -> IO (M.Map BarSeriesId BarSeries)
-    makeBars qtisEp tickersList =
+    makeBars qtisEp confs =
       withContext $ \ctx ->
-        M.fromList <$> mapM (mkBarEntry ctx qtisEp) tickersList
+        M.fromList <$> mapM (mkBarEntry ctx qtisEp) confs
-
+
-    mkBarEntry ctx qtisEp tickerEntry = do
+    mkBarEntry ctx qtisEp conf = do
-      info <- qtisGetTickersInfo ctx qtisEp (code tickerEntry)
+      info <- qtisGetTickersInfo ctx qtisEp (tickerId conf)
-      return (code tickerEntry, BarSeries (code tickerEntry) (Timeframe (timeframeSeconds tickerEntry)) [] (InstrumentParameters (fromInteger $ tiLotSize info) (tiTickSize info)))
+      return (BarSeriesId (tickerId conf) (timeframe conf),
-
+              BarSeries
-
+                (tickerId conf)
-
+                (timeframe conf)
-    runBacktestDriver feeds params tickerList = do
+                []
-      let s = runConduit $ barStreamFromFeeds feeds .| backtestLoop
+                (InstrumentParameters (tickerId conf) (fromInteger $ tiLotSize info) (tiTickSize info)))
-      let finalState = execState (unBacktestingMonad s) $ defaultBacktestState defaultState params tickerList
+
+    runBacktestDriver desc feeds params = do
+      bigConf <- loadConfig (T.pack $ strategyConfigFile params)
+      case confTickers bigConf of
+        tickerList@(firstTicker:restTickers) -> do
+          bars <- makeBars (T.pack $ qtisEndpoint params) tickerList
+          let s = runConduit $ barStreamFromFeeds feeds .| backtestLoop desc
+          let finalState =
+                execState (unBacktestingMonad s) $ defaultBacktestState def (confStrategy bigConf) desc bars (fmap toBarSeriesId (firstTicker :| restTickers))
           print $ finalState ^. cash
           print $ finalState ^. tradesLog
           forM_ (reverse $ finalState ^. logs) putStrLn
+        _ -> return ()
 
-    loadStrategyConfig :: (FromJSON c) => Params -> IO ([Ticker], c)
+    toBarSeriesId conf = BarSeriesId (tickerId conf) (timeframe conf)
-    loadStrategyConfig params = do
-      content <- readFile (strategyConfigFile params)
-      case loadStrategyConfig' content of
-        Just (tickersList, config) -> return (tickersList, config)
-        _ -> throw $ UnableToLoadConfig (T.pack . strategyConfigFile $ params)
-
-    loadStrategyConfig' content = do
-      v <- decode content
-      case v of
-        Object o -> do
-          mbTickers <- "tickers" `lookup` o
-          mbParams <- "params" `lookup` o
-          tickers' <- parseMaybe parseJSON mbTickers
-          params <- parseMaybe parseJSON mbParams
-          return (tickers', params)
-        _ -> Nothing
 
+    barStreamFromFeeds :: (Monad m) => V.Vector (BarTimeframe, [Bar]) -> ConduitT () (BarSeriesId, Bar) m ()
     barStreamFromFeeds feeds = case nextBar feeds of
-      Just (bar, feeds') -> yield bar >> barStreamFromFeeds feeds'
+      Just (tf, bar, feeds') -> yield (BarSeriesId (barSecurity bar) tf, bar) >> barStreamFromFeeds feeds'
       _                  -> return ()
 
-    nextBar :: V.Vector [Bar] -> Maybe (Bar, V.Vector [Bar])
+    nextBar :: V.Vector (BarTimeframe, [Bar]) -> Maybe (BarTimeframe, Bar, V.Vector (BarTimeframe, [Bar]))
     nextBar feeds = case indexOfNextFeed feeds of
       Just ix -> do
-        f <- feeds !? ix
+        (tf, f) <- feeds !? ix
         h <- headMay f
-        return (h, feeds // [(ix, tail f)])
+        return (tf, h, feeds // [(ix, (tf, tail f))])
       _ -> Nothing
 
     indexOfNextFeed feeds = runST $ do
       minTs <- newSTRef Nothing
       minIx <- newSTRef Nothing
       forM_ [0..(V.length feeds-1)] (\ix -> do
-        let feed = feeds ! ix
+        let (_, feed) = feeds ! ix
         curTs <- readSTRef minTs
         case feed of
           x:_ -> case curTs of
@@ -182,22 +258,28 @@ backtestMain _dataDownloadDelta defaultState callback = do
           _ -> return ())
       readSTRef minIx
 
-    backtestLoop = awaitForever (\bar -> do
+    backtestLoop :: StrategyDescriptor c s -> ConduitT (BarSeriesId, Bar) Void (BacktestingMonad c s) ()
+    backtestLoop desc =
+      awaitForever (\(bsId, bar) -> do
       _curState <- use robotState
       _env <- gets _strategyEnvironment
       let newTimestamp = barTimestamp bar
-      strategyEnvironment . seBars %= (flip updateBars bar)
+      barsMap %= updateBars bsId bar
       strategyEnvironment . seLastTimestamp .= newTimestamp
-      enqueueEvent (NewBar bar)
+      enqueueEvent (NewBar (bsIdTf bsId, bar))
-      lift handleEvents)
+      lift (handleEvents desc))
+
+    bsIdTf (BarSeriesId _ tf) = tf
 
-    handleEvents = do
+
+handleEvents :: StrategyDescriptor c s -> BacktestingMonad c s ()
+handleEvents desc = do
   events <- use pendingEvents
   case events of
     x :<| xs -> do
       pendingEvents .= xs
-          handleEvent x
+      handleEvent desc x
-          handleEvents
+      handleEvents desc
     _ -> return ()
 
 executePendingOrders bar = do
@@ -238,9 +320,9 @@ backtestMain _dataDownloadDelta defaultState callback = do
 executeAtPrice order price = do
   ts <- use $ strategyEnvironment . seLastTimestamp
   let thisTrade = mkTrade order price ts
-      tradesLog %= (\log' -> thisTrade : log')
+  tradesLog %= (thisTrade :)
-      pendingEvents %= (\s -> (OrderUpdate (orderId order) Executed) <| s)
+  pendingEvents %= (\s -> OrderUpdate (orderId order) Executed <| s)
-      pendingEvents %= (\s -> (NewTrade thisTrade) <| s)
+  pendingEvents %= (\s -> NewTrade thisTrade <| s)
 
 mkTrade :: Order -> Price -> UTCTime -> Trade
 mkTrade order price ts = Trade {
@@ -257,51 +339,43 @@ backtestMain _dataDownloadDelta defaultState callback = do
   tradeSignalId = orderSignalId order
                             }
 
-    handleEvent event@(NewBar bar) = do
+handleEvent :: StrategyDescriptor c s -> Event -> BacktestingMonad c s ()
+handleEvent desc event@(NewBar (_, bar)) = do
   executePendingOrders bar
-      handleEvents -- This should pass OrderUpdate events to the callback before NewBar events
+  handleEvents desc -- This should pass OrderUpdate events to the callback before NewBar events
   firedTimers <- fireTimers (barTimestamp bar)
-      mapM_ (\x -> enqueueEvent (TimerFired x)) firedTimers
+  mapM_ (enqueueEvent . TimerFired) firedTimers
-      handleEvent' event
+  handleEvent' desc event
   return ()
 
-    handleEvent event = handleEvent' event
+handleEvent desc event = handleEvent' desc event
-
-    handleEvent' event = callback event
 
-    updateBars barMap newbar = M.alter (\case
+handleEvent' desc event = eventCallback desc event
-      Nothing -> Just BarSeries { bsTickerId = barSecurity newbar,
-        bsTimeframe = Timeframe 60,
-        bsBars = [newbar, newbar] }
-      Just bs -> Just bs { bsBars = updateBarList newbar (bsBars bs) }) (barSecurity newbar) barMap
 
-    updateBarList newbar (_:bs) = newbar:newbar:bs
+updateBars bsId newbar barMap = M.adjust (\bs -> bs { bsBars = newbar : bsBars bs }) bsId barMap
-    updateBarList newbar _      = newbar:[newbar]
 
 fireTimers ts = do
   (firedTimers, otherTimers) <- partition (< ts) <$> use pendingTimers
   pendingTimers .= otherTimers
   return firedTimers
 
-    loadFeeds :: [Feed] -> IO (V.Vector [Bar])
+loadFeeds :: [Feed] -> IO (V.Vector (BarTimeframe, [Bar]))
 loadFeeds feeds = V.fromList <$> mapM loadFeed feeds
 loadFeed (Feed tid path) = do
   content <- readFile path
-      case QF.parseQuotes $ toStrict content of
+  case parseQuotes $ toStrict content of
-        Just quotes -> return $ fmap (rowToBar tid) quotes
+    Just quotes -> case headMay quotes of
+      Just first -> return (BarTimeframe (rowTimeframe first), fmap (rowToBar tid) quotes)
+      Nothing    -> throw $ UnableToLoadFeed (T.pack path)
     _           -> throw $ UnableToLoadFeed (T.pack path)
 
 rowToBar tid r = Bar tid (rowTime r) (rowOpen r) (rowHigh r) (rowLow r) (rowClose r) (rowVolume r)
 
+enqueueEvent :: MonadState (BacktestState c s) m => Event -> m ()
+enqueueEvent event = pendingEvents %= (|> event)
 
-    enqueueEvent event = pendingEvents %= (\s -> s |> event)
+defaultBacktestState :: s -> c -> StrategyDescriptor c s -> M.Map BarSeriesId BarSeries -> NonEmpty BarSeriesId -> BacktestState c s
-
+defaultBacktestState s c desc = BacktestState desc 0 s c (StrategyEnvironment "" "" 1 (UTCTime (fromGregorian 1970 1 1) 0)) [] Seq.empty [] 1 [] []
-instance (Default c, Default s) => Default (BacktestState c s)
-  where
-    def = defaultBacktestState def def def
-
-defaultBacktestState :: s -> c -> Bars -> BacktestState c s
-defaultBacktestState s c bars = BacktestState 0 s c (StrategyEnvironment "" "" 1 bars (UTCTime (fromGregorian 1970 1 1) 0)) [] Seq.empty [] 1 [] []
 
 newtype BacktestingMonad s c a = BacktestingMonad { unBacktestingMonad :: State (BacktestState s c) a }
   deriving (Functor, Applicative, Monad, MonadState (BacktestState s c))
@@ -315,21 +389,38 @@ instance MonadRobot (BacktestingMonad c s) c s where
   submitOrder order = do
     oid <- nextOrderId
     let orderWithId = order { orderId = oid }
-    pendingOrders %= ((:) orderWithId)
+    pendingOrders %= (orderWithId :)
-    pendingEvents %= (\s -> s |> (OrderSubmitted orderWithId))
+    pendingEvents %= (\s -> s |> OrderUpdate oid Submitted)
+    return oid
   cancelOrder oid = do
     orders <- use pendingOrders
     let (matchingOrders, otherOrders) = partition (\o -> orderId o == oid) orders
     case matchingOrders of
       [] -> return ()
       xs -> do
-        mapM_ (\o -> pendingEvents %= (\s -> s |> (OrderUpdate (orderId o) Cancelled))) xs
+        mapM_ (\o -> pendingEvents %= (\s -> s |> OrderUpdate (orderId o) Cancelled)) xs
         pendingOrders .= otherOrders
-  appendToLog txt = logs %= ((:) (TL.toStrict txt))
+  appendToLog _ txt = logs %= ((TL.toStrict txt) :)
-  setupTimer time = pendingTimers %= ((:) time)
+  setupTimer time = pendingTimers %= (time :)
   enqueueIOAction _actionId _action = error "Backtesting io actions is not supported"
   getConfig = use robotParams
   getState = use robotState
   setState s = robotState .= s
   getEnvironment = use strategyEnvironment
+  getTicker tid tf = do
+    m <- gets _barsMap
+    return $ M.lookup (BarSeriesId tid tf) m
+  getTickerInfo tid = do
+    tickers <- getAvailableTickers
+    case L.find (\(BarSeriesId t _) -> t == tid) tickers of
+      Just (BarSeriesId t tf) -> do
+        ticker <- getTicker t tf
+        return (bsParams <$> ticker)
+      Nothing                 -> return Nothing
+  getAvailableTickers = use availableTickers
+
+instance ConfigStorage IO where
+  loadConfig filepath = do
+    cfg <- B.readFile $ T.unpack filepath
+    input auto (decodeUtf8 cfg)
 

src/ATrade/Quotes/QTIS.hs

@@ -37,9 +37,8 @@ instance ToJSON TickerInfo where
     "lot_size" .= tiLotSize ti,
     "tick_size" .= tiTickSize ti ]
 
-qtisGetTickersInfo :: (WithLog env Message m, MonadIO m) => Context -> T.Text -> TickerId -> m TickerInfo
+qtisGetTickersInfo :: (MonadIO m) => Context -> T.Text -> TickerId -> m TickerInfo
 qtisGetTickersInfo ctx endpoint tickerId = do
-  logInfo "QTIS" $ "Requesting ticker: " <> tickerId <> " from " <> endpoint
   liftIO $ withSocket ctx Req $ \sock -> do
     connect sock $ T.unpack endpoint
     send sock [] $ BL.toStrict tickerRequest

src/ATrade/RoboCom/Positions.hs

@@ -223,7 +223,8 @@ orderDeadline maybeDeadline lastTs =
 
 
 dispatchPosition :: (StateHasPositions s, MonadRobot m c s) => Event -> Position -> m Position
-dispatchPosition event pos = case posState pos of
+dispatchPosition event pos =
+  case posState pos of
     PositionWaitingOpenSubmission pendingOrder -> handlePositionWaitingOpenSubmission pendingOrder
     PositionWaitingOpen -> handlePositionWaitingOpen
     PositionOpen -> handlePositionOpen
@@ -236,7 +237,9 @@ dispatchPosition event pos = case posState pos of
     handlePositionWaitingOpenSubmission pendingOrder = do
       lastTs <- view seLastTimestamp <$> getEnvironment
       if orderDeadline (posSubmissionDeadline pos) lastTs
-        then return $ pos { posState = PositionCancelled } -- TODO call TimeoutHandler if present
+        then do
+          appendToLog Warning $ [t|Submission deadline: %?, %?|] lastTs (posSubmissionDeadline pos)
+          return $ pos { posState = PositionCancelled } -- TODO call TimeoutHandler if present
         else case event of
           OrderUpdate oid Submitted -> do
             return $ if orderId pendingOrder == oid