diff --git a/haverer.cabal b/haverer.cabal
--- a/haverer.cabal
+++ b/haverer.cabal
@@ -16,7 +16,7 @@
 -- see http://haskell.org/cabal/users-guide/
 
 name:                haverer
-version:             0.1.0.0
+version:             0.2.0.0
 synopsis:            Implementation of the rules of Love Letter
 description:         Implementation of the rules of Love Letter
 license:             Apache-2.0
diff --git a/lib/Haverer.hs b/lib/Haverer.hs
--- a/lib/Haverer.hs
+++ b/lib/Haverer.hs
@@ -38,7 +38,8 @@
   currentTurn,
   Card(..),
   Deck,
-  Complete,
+  DeckSize(..),
+  FullDeck,
   newDeck,
   Play(..),
   viewAction,
@@ -52,7 +53,7 @@
 
 
 import Haverer.Action (Play(..), viewAction)
-import Haverer.Deck (Card(..), Complete, Deck, newDeck)
+import Haverer.Deck (Card(..), Deck, DeckSize(..), FullDeck, newDeck)
 import Haverer.Game (
   Game,
   finalScores,
diff --git a/lib/Haverer/Deck.hs b/lib/Haverer/Deck.hs
--- a/lib/Haverer/Deck.hs
+++ b/lib/Haverer/Deck.hs
@@ -12,6 +12,8 @@
 -- See the License for the specific language governing permissions and
 -- limitations under the License.
 
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
 
@@ -19,10 +21,10 @@
   allCards,
   baseCards,
   Card(..),
-  Complete,
+  DeckSize(..),
   deal,
   Deck,
-  Incomplete,
+  FullDeck,
   makeDeck,
   newDeck,
   pop,
@@ -45,11 +47,13 @@
 allCards = [Soldier ..]
 
 
-data Complete
-data Incomplete
+data DeckSize = Incomplete | Complete
 
-newtype Deck a = Deck [Card] deriving (Eq, Show, Ord)
+newtype Deck (a :: DeckSize) = Deck [Card] deriving (Eq, Show, Ord)
 
+type FullDeck = Deck 'Complete
+
+
 baseCards :: [Card]
 baseCards = [
   Soldier
@@ -70,28 +74,31 @@
   , Prince
   ]
 
-baseDeck :: Deck Complete
+baseDeck :: Deck 'Complete
 baseDeck = Deck baseCards
 
 shuffleDeck :: MonadRandom m => Deck a -> m (Deck a)
 shuffleDeck (Deck d) = liftM Deck $ shuffleM d
 
-newDeck :: MonadRandom m => m (Deck Complete)
+newDeck :: MonadRandom m => m (Deck 'Complete)
 newDeck = shuffleDeck baseDeck
 
-makeDeck :: [Card] -> Maybe (Deck Complete)
+makeDeck :: [Card] -> Maybe (Deck 'Complete)
 makeDeck cards =
   if sort cards == baseCards then Just (Deck cards) else Nothing
 
-pop :: Deck a -> (Maybe Card, Deck Incomplete)
+pop :: Deck a -> (Maybe Card, Deck 'Incomplete)
 pop (Deck []) = (Nothing, Deck [])
 pop (Deck (c:cards)) = (Just c, Deck cards)
 
-deal :: Deck a -> Int -> (Maybe [Card], Deck Incomplete)
-deal (Deck cards) n =
+
+deal :: FullDeck -> Int -> Maybe (Card, [Card], Deck 'Incomplete)
+deal (Deck (burn:cards)) n =
   case splitAt n cards of
-   (_, []) -> (Nothing, Deck cards)
-   (top, rest) -> (Just top, Deck rest)
+   (_, []) -> Nothing
+   (top, rest) -> Just (burn, top, Deck rest)
+deal (Deck _) _ = Nothing
+
 
 toList :: Deck a -> [Card]
 toList (Deck xs) = xs
diff --git a/lib/Haverer/Game.hs b/lib/Haverer/Game.hs
--- a/lib/Haverer/Game.hs
+++ b/lib/Haverer/Game.hs
@@ -32,7 +32,7 @@
 import BasicPrelude
 import Control.Monad.Random (MonadRandom)
 
-import Haverer.Deck (Deck, Complete, newDeck)
+import Haverer.Deck (FullDeck, newDeck)
 import Haverer.Player (
   PlayerSet,
   toPlayers,
@@ -67,7 +67,7 @@
   }
 
 -- | Start a new round of the game with an already-shuffled deck of cards.
-newRound' :: (Ord playerId, Show playerId) => Game playerId -> Deck Complete -> Round playerId
+newRound' :: (Ord playerId, Show playerId) => Game playerId -> FullDeck -> Round playerId
 newRound' game deck = Round.makeRound deck (_playerSet game)
 
 -- | Start a new round of the game, shuffling the deck cards ourselves.
diff --git a/lib/Haverer/Round.hs b/lib/Haverer/Round.hs
--- a/lib/Haverer/Round.hs
+++ b/lib/Haverer/Round.hs
@@ -12,6 +12,7 @@
 -- See the License for the specific language governing permissions and
 -- limitations under the License.
 
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -33,6 +34,7 @@
   , currentPlayer
   , currentTurn
   , getActivePlayers
+  , getBurnCard
   , getPlayer
   , getPlayerMap
   , getPlayers
@@ -42,6 +44,7 @@
 
     -- The outcome of a Round
   , Victory(..)
+  , survivors
   , victory
 
     -- Properties used for testing that rely on unexposed fields.
@@ -69,7 +72,7 @@
   getTarget,
   playToAction,
   viewAction)
-import Haverer.Deck (Card(..), Complete, Deck, deal, Incomplete, pop)
+import Haverer.Deck (Card(..), Deck, DeckSize(..), FullDeck, deal, pop)
 import qualified Haverer.Deck as Deck
 import Haverer.Player (
   bust,
@@ -98,7 +101,7 @@
 
 
 data Round playerId = Round {
-  _stack :: Deck Incomplete,
+  _stack :: Deck 'Incomplete,
   _playOrder :: Ring playerId,
   _players :: Map playerId Player,
   _roundState :: RoundState,
@@ -110,19 +113,17 @@
 
 
 -- | Make a new round, given a complete Deck and a set of players.
-makeRound :: (Ord playerId, Show playerId) => Deck Complete -> PlayerSet playerId -> Round playerId
+makeRound :: (Ord playerId, Show playerId) => FullDeck -> PlayerSet playerId -> Round playerId
 makeRound deck playerSet =
   nextTurn $ case deal deck (length playerList) of
-   (Just cards, remainder) ->
-     case pop remainder of
-      (Nothing, _) -> terror ("Not enough cards for burn: " ++ show deck)
-      (Just burn', stack') -> Round {
-        _stack = stack',
-        _playOrder = fromJust (makeRing playerList),
-        _players = Map.fromList $ zip playerList (map makePlayer cards),
-        _roundState = NotStarted,
-        _burn = burn'
-        }
+   Just (burn', cards, stack') ->
+     Round {
+       _stack = stack',
+       _playOrder = fromJust (makeRing playerList),
+       _players = Map.fromList $ zip playerList (map makePlayer cards),
+       _roundState = NotStarted,
+       _burn = burn'
+       }
    _ -> terror ("Given a complete deck - " ++ show deck ++ "- that didn't have enough cards for players - " ++ show playerSet)
   where playerList = toPlayers playerSet
 
@@ -158,6 +159,16 @@
 getPlayer round pid = view (players . at pid) round
 
 
+-- | Get the burn card for the Round. Only possible when the Round is over.
+--
+-- Since 0.1.1
+getBurnCard :: Round playerId -> Maybe Card
+getBurnCard round =
+  case view roundState round of
+   Over -> Just $ view burn round
+   _ -> Nothing
+
+
 -- | Draw a card from the top of the Deck. Returns the card and a new Round.
 drawCard :: Monad m => StateT (Round playerId) m (Maybe Card)
 drawCard = do
@@ -399,19 +410,21 @@
   deriving (Eq, Show)
 
 
--- | The currently surviving players in the round, with their cards.
-survivors :: Round playerId -> [(playerId, Card)]
-survivors = Map.toList . Map.mapMaybe getHand . view players
-
-
 -- | If the Round is Over, return the Victory data. Otherwise, Nothing.
 victory :: Round playerId -> Maybe (Victory playerId)
 victory (round@Round { _roundState = Over }) =
-  case survivors round of
+  case survivors' round of
    [(pid, card)] -> Just $ SoleSurvivor pid card
    xs -> let (best:rest) = reverse (groupBy ((==) `on` snd) (sortBy (compare `on` snd) xs))
          in Just $ HighestCard (snd $ head best) (map fst best) (concat rest)
+  where survivors' = Map.toList . Map.mapMaybe getHand . view players
 victory _ = Nothing
+
+
+-- | The currently surviving players in the round, with their cards.
+survivors :: Victory playerId -> [(playerId, Card)]
+survivors (SoleSurvivor pid card) = [(pid, card)]
+survivors (HighestCard topCard topPlayers rest) = zip topPlayers (repeat topCard) ++ rest
 
 
 getWinners :: Victory playerId -> [playerId]
diff --git a/lib/Haverer/Testing.hs b/lib/Haverer/Testing.hs
--- a/lib/Haverer/Testing.hs
+++ b/lib/Haverer/Testing.hs
@@ -33,7 +33,7 @@
 import Test.Tasty.QuickCheck
 
 import Haverer.Action (Play(..))
-import Haverer.Deck (baseCards, Card(..), Complete, Deck, makeDeck)
+import Haverer.Deck (baseCards, Card(..), FullDeck, makeDeck)
 import Haverer.Player (PlayerSet, toPlayerSet)
 import Haverer.Round (
   Round
@@ -48,7 +48,7 @@
 type PlayerId = Int
 
 
-instance Arbitrary (Deck Complete) where
+instance Arbitrary FullDeck where
   -- | An arbitrary complete deck is a shuffled set of cards.
   arbitrary = fmap (fromJust . makeDeck) (shuffled baseCards)