diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,11 @@
 # Revision history for lifx-lan
 
-## 0.1.0.2 -- YYYY-mm-dd
+## 0.2.0 -- 2021-06-18
+
+* Enable querying state (colour or power level).
+
+    * Various breaking changes to enable this.
+
+## 0.1.0.2
 
 * Basic. Only supports setting power and colour.
diff --git a/lifx-lan.cabal b/lifx-lan.cabal
--- a/lifx-lan.cabal
+++ b/lifx-lan.cabal
@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               lifx-lan
-version:            0.1.0.2
+version:            0.2.0
 license:            BSD-3-Clause
 license-file:       LICENSE
 author:             George Thomas
@@ -32,15 +32,18 @@
         time ^>= 1.9.3,
     default-language: Haskell2010
     default-extensions:
+        AllowAmbiguousTypes
         BlockArguments
         DeriveAnyClass
         DeriveFunctor
         DeriveGeneric
         DerivingStrategies
         DerivingVia
+        DuplicateRecordFields
         EmptyCase
         FlexibleContexts
         FlexibleInstances
+        GADTs
         GeneralizedNewtypeDeriving
         ImportQualifiedPost
         LambdaCase
diff --git a/src/Lifx/Lan.hs b/src/Lifx/Lan.hs
--- a/src/Lifx/Lan.hs
+++ b/src/Lifx/Lan.hs
@@ -7,41 +7,77 @@
     runLifx,
     LifxT (..),
     runLifxT,
+    LifxError (..),
     MonadLifx (..),
 
+    -- * Responses
+    LightState (..),
+    StatePower (..),
+
     -- * Low-level
     encodeMessage,
     Header (..),
 ) where
 
 import Control.Monad
+import Control.Monad.Except
 import Control.Monad.Reader
-import Control.Monad.State
+import Control.Monad.State hiding (get, put)
 import Data.Binary
+import Data.Binary.Get hiding (label)
 import Data.Binary.Put
 import Data.Bits
+import Data.ByteString qualified as BS
 import Data.ByteString.Lazy qualified as BL
+import Data.Either.Extra
+import Data.Function
+import Data.Tuple.Extra
 import GHC.Generics (Generic)
+import GHC.IO.Exception
 import Network.Socket
 import Network.Socket.ByteString
 import System.Random
+import System.Timeout
 
 {- Core -}
 
 lifxPort :: PortNumber
 lifxPort = 56700
 
-sendMessage :: MonadLifx m => HostAddress -> Message -> m ()
+sendMessage :: MonadLifx m => HostAddress -> Message a -> m a
 sendMessage lightAddr msg = do
     sock <- getSocket
     source <- getSource
-    sequenceCounter <- getCounter
+    timeoutDuration <- getTimeout
+    counter <- getCounter
     incrementCounter
+    let receiver = SockAddrInet lifxPort lightAddr
     void . liftIO $
         sendTo
             sock
-            (BL.toStrict $ encodeMessage False sequenceCounter source msg)
-            (SockAddrInet lifxPort lightAddr)
+            (BL.toStrict $ encodeMessage False counter source msg)
+            receiver
+    getResponse' msg & either pure \(expectedPacketType, messageSize, getBody) -> do
+        (bs, sender) <-
+            throwEither . liftIO . fmap (maybeToEither RecvTimeout)
+                . timeout timeoutDuration
+                . recvFrom sock
+                $ headerSize + messageSize
+        when (sender /= receiver) $ lifxThrow $ WrongSender receiver sender
+        case runGetOrFail get $ BL.fromStrict bs of
+            Left e -> throwDecodeFailure e
+            Right (bs', _, Header{packetType, sequenceCounter}) -> do
+                when (sequenceCounter /= counter) $ lifxThrow $ WrongSequenceNumber counter sequenceCounter
+                when (packetType /= expectedPacketType) $ lifxThrow $ WrongPacketType packetType expectedPacketType
+                case runGetOrFail getBody bs' of
+                    Left e -> throwDecodeFailure e
+                    Right (_, _, res) -> pure res
+  where
+    throwDecodeFailure (bs, bo, e) = lifxThrow $ DecodeFailure (BL.toStrict bs) bo e
+    throwEither x =
+        x >>= \case
+            Left e -> lifxThrow e
+            Right r -> pure r
 
 data HSBK = HSBK
     { hue :: Word16
@@ -53,53 +89,146 @@
 newtype Duration = Duration Word32
     deriving (Eq, Ord, Show, Generic)
 
--- | https://lan.developer.lifx.com/docs/changing-a-device
-data Message
-    = SetPower Bool
-    | SetColor HSBK Duration
-    | SetLightPower Bool Duration
+data Message a where
+    GetPower :: Message StatePower
+    SetPower :: Bool -> Message ()
+    GetColor :: Message LightState
+    SetColor :: HSBK -> Duration -> Message ()
+    SetLightPower :: Bool -> Duration -> Message ()
+deriving instance (Eq (Message a))
+deriving instance (Ord (Message a))
+deriving instance (Show (Message a))
 
+newtype StatePower = StatePower
+    { power :: Word16
+    }
+    deriving (Eq, Ord, Show, Generic)
+data LightState = LightState
+    { hsbk :: HSBK
+    , power :: Word16
+    , label :: BS.ByteString
+    }
+    deriving (Eq, Ord, Show, Generic)
+
+data LifxError
+    = DecodeFailure BS.ByteString ByteOffset String
+    | RecvTimeout
+    | WrongPacketType Word16 Word16 -- expected, then actual
+    | WrongSender SockAddr SockAddr -- expected, then actual
+    | WrongSequenceNumber Word8 Word8 -- expected, then actual
+    deriving (Eq, Ord, Show, Generic)
+
+{- Message responses -}
+
+class Response a where
+    getResponse :: Either a (Word16, Int, Get a)
+
+instance Response () where
+    getResponse = Left ()
+instance Response LightState where
+    getResponse = Right $ (107,52,) do
+        hsbk <- HSBK <$> getWord16le <*> getWord16le <*> getWord16le <*> getWord16le
+        skip 2
+        power <- getWord16le
+        label <- BS.takeWhile (/= 0) <$> getByteString 32
+        skip 8
+        pure LightState{..}
+instance Response StatePower where
+    getResponse =
+        Right . (22,2,) $
+            StatePower <$> getWord16le
+
+-- | Seeing as all `Message` response types are instances of `Response`, we can hide that type class from users.
+getResponse' :: Message a -> Either a (Word16, Int, Get a)
+getResponse' = \case
+    GetPower{} -> getResponse
+    SetPower{} -> getResponse
+    GetColor{} -> getResponse
+    SetColor{} -> getResponse
+    SetLightPower{} -> getResponse
+
 {- Monad -}
 
 type Lifx = LifxT IO
-newtype LifxT m a = LifxT {unLifxT :: StateT Word8 (ReaderT (Socket, Word32) m) a}
-    deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader (Socket, Word32), MonadState Word8)
+newtype LifxT m a = LifxT
+    { unLifxT ::
+        StateT
+            Word8
+            ( ReaderT
+                (Socket, Word32, Int)
+                ( ExceptT
+                    LifxError
+                    m
+                )
+            )
+            a
+    }
+    deriving newtype
+        ( Functor
+        , Applicative
+        , Monad
+        , MonadIO
+        )
 
+{- | Note that this throws 'LifxError's as 'IOException's, and sets timeout to 1 second.
+Use 'runLifxT' for more control.
+-}
 runLifx :: Lifx a -> IO a
-runLifx = runLifxT
-runLifxT :: MonadIO m => LifxT m a -> m a
-runLifxT (LifxT x) = do
+runLifx m =
+    runLifxT 1_000_000 m >>= \case
+        Left e ->
+            ioError
+                IOError
+                    { ioe_handle = Nothing
+                    , ioe_type = OtherError
+                    , ioe_location = "LIFX"
+                    , ioe_description = show e
+                    , ioe_errno = Nothing
+                    , ioe_filename = Nothing
+                    }
+        Right x -> pure x
+
+runLifxT :: MonadIO m => Int -> LifxT m a -> m (Either LifxError a)
+runLifxT timeoutDuration (LifxT x) = do
     sock <- liftIO $ socket AF_INET Datagram defaultProtocol
     liftIO . bind sock $ SockAddrInet defaultPort 0
     source <- randomIO
-    runReaderT (evalStateT x 0) (sock, source)
+    runExceptT $ runReaderT (evalStateT x 0) (sock, source, timeoutDuration)
 
 class MonadIO m => MonadLifx m where
     getSocket :: m Socket
     getSource :: m Word32
+    getTimeout :: m Int
     incrementCounter :: m ()
     getCounter :: m Word8
+    lifxThrow :: LifxError -> m a
 instance MonadIO m => MonadLifx (LifxT m) where
-    getSocket = asks fst
-    getSource = asks snd
-    incrementCounter = modify succ'
-    getCounter = gets id
+    getSocket = LifxT $ asks fst3
+    getSource = LifxT $ asks snd3
+    getTimeout = LifxT $ asks thd3
+    incrementCounter = LifxT $ modify succ'
+    getCounter = LifxT $ gets id
+    lifxThrow = LifxT . throwError
 instance MonadLifx m => MonadLifx (StateT s m) where
     getSocket = lift getSocket
     getSource = lift getSource
+    getTimeout = lift getTimeout
     incrementCounter = lift incrementCounter
     getCounter = lift getCounter
+    lifxThrow = lift . lifxThrow
 instance MonadLifx m => MonadLifx (ReaderT e m) where
     getSocket = lift getSocket
     getSource = lift getSource
+    getTimeout = lift getTimeout
     incrementCounter = lift incrementCounter
     getCounter = lift getCounter
+    lifxThrow = lift . lifxThrow
 
 {- Low level -}
 
-encodeMessage :: Bool -> Word8 -> Word32 -> Message -> BL.ByteString
+encodeMessage :: Bool -> Word8 -> Word32 -> Message a -> BL.ByteString
 encodeMessage ackRequired sequenceCounter source msg =
-    runPut $ putHeader (messageHeader ackRequired sequenceCounter source msg) >> putMessagePayload msg
+    runPut $ put (messageHeader ackRequired sequenceCounter source msg) >> putMessagePayload msg
 
 -- | https://lan.developer.lifx.com/docs/encoding-a-packet
 data Header = Header
@@ -115,38 +244,70 @@
     , sequenceCounter :: Word8
     , packetType :: Word16
     }
+    deriving (Eq, Ord, Show, Generic)
 
-putHeader :: Header -> Put
-putHeader Header{..} = do
-    putWord16le size
-    putWord16le $
-        protocol
-            .|. bitIf addressable 12
-            .|. bitIf tagged 13
-            .|. bitIf (testBit origin 0) 14
-            .|. bitIf (testBit origin 1) 15
-    putWord32le source
-    putWord64be target
-    replicateM_ 6 $ putWord8 0
-    putWord8 $
-        zeroBits
-            .|. bitIf resRequired 0
-            .|. bitIf ackRequired 1
-    putWord8 sequenceCounter
-    replicateM_ 8 $ putWord8 0
-    putWord16le packetType
-    replicateM_ 2 $ putWord8 0
-  where
-    bitIf b n = if b then bit n else zeroBits
+instance Binary Header where
+    get = do
+        size <- getWord16le
+        protBytes <- getWord16le
+        let protocol = flip clearBit 12 . flip clearBit 13 . flip clearBit 14 . flip clearBit 15 $ protBytes
+            addressable = testBit protBytes 12
+            tagged = testBit protBytes 13
+            origin = (if testBit protBytes 14 then 0 else 1) + (if testBit protBytes 15 then 0 else 2)
+        source <- getWord32le
+        target <- getWord64be
+        skip 6
+        resAckByte <- getWord8
+        let resRequired = testBit resAckByte 0
+            ackRequired = testBit resAckByte 1
+        sequenceCounter <- getWord8
+        skip 8
+        packetType <- getWord16le
+        skip 2
+        pure Header{..}
 
-messageHeader :: Bool -> Word8 -> Word32 -> Message -> Header
+    put Header{..} = do
+        putWord16le size
+        putWord16le $
+            protocol
+                .|. bitIf addressable 12
+                .|. bitIf tagged 13
+                .|. bitIf (testBit origin 0) 14
+                .|. bitIf (testBit origin 1) 15
+        putWord32le source
+        putWord64be target
+        replicateM_ 6 $ putWord8 0
+        putWord8 $
+            zeroBits
+                .|. bitIf resRequired 0
+                .|. bitIf ackRequired 1
+        putWord8 sequenceCounter
+        replicateM_ 8 $ putWord8 0
+        putWord16le packetType
+        replicateM_ 2 $ putWord8 0
+      where
+        bitIf b n = if b then bit n else zeroBits
+
+messageHeader :: Bool -> Word8 -> Word32 -> Message a -> Header
 messageHeader ackRequired sequenceCounter source = \case
+    GetPower{} ->
+        Header
+            { size = headerSize
+            , packetType = 20
+            , ..
+            }
     SetPower{} ->
         Header
             { size = headerSize + 2
             , packetType = 21
             , ..
             }
+    GetColor{} ->
+        Header
+            { size = headerSize
+            , packetType = 101
+            , ..
+            }
     SetColor{} ->
         Header
             { size = headerSize + 13
@@ -160,18 +321,19 @@
             , ..
             }
   where
-    target = 0
-    headerSize = 36
-    protocol = 1024
+    target = 0 :: Word64
+    protocol = 1024 :: Word16
     tagged = True
     addressable = True
-    origin = 0
+    origin = 0 :: Word8
     resRequired = False
 
-putMessagePayload :: Message -> Put
+putMessagePayload :: Message a -> Put
 putMessagePayload = \case
+    GetPower -> mempty
     SetPower b ->
         putWord16le if b then maxBound else minBound
+    GetColor -> mempty
     SetColor HSBK{..} (Duration d) -> do
         putWord8 0
         putWord16le hue
@@ -190,3 +352,6 @@
 succ' e
     | e == maxBound = minBound
     | otherwise = succ e
+
+headerSize :: Num a => a
+headerSize = 36