diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2024, Sean Hess
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Sean Hess nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,12 @@
+
+Telescope
+=========
+
+
+[![Hackage](https://img.shields.io/hackage/v/telescope.svg&color=success)](https://hackage.haskell.org/package/telescope)
+
+Haskell library to read and write Astronomical images from telescopes
+
+* [FITS](https://fits.gsfc.nasa.gov/fits_standard.html) File Format
+* [ASDF](https://asdf-standard.readthedocs.io/) File Format
+
diff --git a/src/Telescope/Asdf.hs b/src/Telescope/Asdf.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Asdf.hs
@@ -0,0 +1,35 @@
+module Telescope.Asdf
+  ( ToAsdf (..)
+  , FromAsdf (..)
+  , decodeM
+  , decodeEither
+  , decode
+  , encodeM
+  , encode
+  , AsdfError
+  , FromNDArray (..)
+  , ToNDArray (..)
+  , SchemaTag
+  , Node (..)
+  , Value (..)
+  , Key
+  , Object
+  , fromValue
+  , NDArrayData (..)
+  , jsonPointer
+  , jsonReference
+  , JSONReference (..)
+  , JSONPointer (..)
+  , Anchor (..)
+  , Parser
+  , Asdf (..)
+  )
+where
+
+import Telescope.Asdf.Class
+import Telescope.Asdf.Core (Asdf (..))
+import Telescope.Asdf.Encoding
+import Telescope.Asdf.Error
+import Telescope.Asdf.NDArray
+import Telescope.Asdf.Node
+
diff --git a/src/Telescope/Asdf/Class.hs b/src/Telescope/Asdf/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Asdf/Class.hs
@@ -0,0 +1,479 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+
+module Telescope.Asdf.Class where
+
+import Data.List ((!?))
+import Data.List.NonEmpty (NonEmpty (..))
+import Data.List.NonEmpty qualified as NE
+import Data.Massiv.Array (Array, Prim)
+import Data.Massiv.Array qualified as M
+import Data.Scientific (fromFloatDigits, toRealFloat)
+import Data.Text (Text, pack, unpack)
+import Data.Time.Clock (UTCTime)
+import Data.Time.Format.ISO8601
+import Effectful
+import Effectful.Fail
+import GHC.Generics
+import GHC.Int
+import Telescope.Asdf.Encoding.File (BlockSource (..))
+import Telescope.Asdf.NDArray
+import Telescope.Asdf.Node
+import Telescope.Data.Array
+import Telescope.Data.Axes
+import Telescope.Data.Binary
+import Telescope.Data.Parser
+
+
+{- | Convert a type to an Asdf 'Value' or 'Node'. The generic instance will encode to an 'Object' with field names matching record selectors
+
+> data Example = Example
+>   { name :: Text
+>   , age :: Int
+>   , tags :: [Text]
+>   }
+>   deriving (Generic, ToAsdf)
+>
+> instance ToAsdf Example where
+>   schema _ = "tag:example.org/schemas/example-1.0.0"
+-}
+class ToAsdf a where
+  -- | Specify how an object encodes to a 'Value'
+  --
+  -- > instance User ToAsdf where
+  -- >   toValue user =
+  -- >     Object
+  -- >       [ ("name", toNode user.name)
+  -- >       , ("age", toNode user.age)
+  -- >       ]
+  toValue :: a -> Value
+  default toValue :: (Generic a, GToObject (Rep a)) => a -> Value
+  toValue a = Object $ gToObject (from a)
+
+
+  -- | Specify the schema for a type
+  --
+  -- > instance ToAsdf Unit where
+  -- >   schema _ = "!unit/unit-1.0.0"
+  schema :: a -> SchemaTag
+  default schema :: a -> SchemaTag
+  schema _ = mempty
+
+
+  -- | Specify that this node be saved as an anchor
+  --
+  -- > instance ToAsdf Config where
+  -- >   anchor _ = Just "globalConfig"
+  anchor :: a -> Maybe Anchor
+  default anchor :: a -> Maybe Anchor
+  anchor _ = Nothing
+
+
+  -- | Manually control all aspects of how this is converted to a 'Node'
+  toNode :: a -> Node
+  default toNode :: a -> Node
+  toNode a = Node (schema a) (anchor a) $ toValue a
+
+
+{- | Parse an Asdf 'Value' or 'Node' into a type. The generic instance will decode an 'Object' with field names matching record selectors
+
+> data Example = Example
+>   { name :: Text
+>   , age :: Int
+>   , tags :: [Text]
+>   }
+>   deriving (Generic, FromAsdf)
+-}
+class FromAsdf a where
+  -- | Specify how a type is parsed from a 'Value'
+  --
+  -- > instance FromAsdf Integer where
+  -- >   parseValue = \case
+  -- >     Integer n -> pure $ fromIntegral n
+  -- >     node -> expected "Integer" node
+  parseValue :: (Parser :> es) => Value -> Eff es a
+  default parseValue :: (Generic a, GParseObject (Rep a), Parser :> es) => Value -> Eff es a
+  parseValue (Object o) = to <$> gParseObject o
+  parseValue val = expected "Object" val
+
+
+instance ToAsdf Int where
+  toValue n = toValue (fromIntegral @Int @Int64 n)
+instance FromAsdf Int where
+  parseValue = fmap (fromIntegral @Int64 @Int) <$> parseValue
+
+
+instance ToAsdf Int8 where
+  toValue n = Integer $ fromIntegral n
+instance FromAsdf Int8 where
+  parseValue = parseInteger
+
+
+instance ToAsdf Int16 where
+  toValue n = Integer $ fromIntegral n
+instance FromAsdf Int16 where
+  parseValue = parseInteger
+
+
+instance ToAsdf Int32 where
+  toValue n = Integer $ fromIntegral n
+instance FromAsdf Int32 where
+  parseValue = parseInteger
+
+
+instance ToAsdf Int64 where
+  toValue n = Integer $ fromIntegral n
+instance FromAsdf Int64 where
+  parseValue = parseInteger
+
+
+instance ToAsdf Integer where
+  toValue n = Integer $ fromIntegral n
+instance FromAsdf Integer where
+  parseValue = parseInteger
+
+
+instance ToAsdf Double where
+  toValue n = Number $ fromFloatDigits n
+instance FromAsdf Double where
+  parseValue = \case
+    Number n -> pure $ toRealFloat n
+    node -> expected "Double" node
+
+
+instance ToAsdf Float where
+  toValue n = Number $ fromFloatDigits n
+instance FromAsdf Float where
+  parseValue = \case
+    Number n -> pure $ toRealFloat n
+    node -> expected "Float" node
+
+
+parseInteger :: (Integral a, Parser :> es) => Value -> Eff es a
+parseInteger = \case
+  Integer n -> pure $ fromIntegral n
+  node -> expected "Integer" node
+
+
+instance {-# OVERLAPPABLE #-} (FromAsdf a) => FromAsdf [a] where
+  parseValue = \case
+    Array ns -> mapM (parseNode @a) ns
+    node -> expected "Array" node
+instance {-# OVERLAPPABLE #-} (ToAsdf a) => ToAsdf [a] where
+  toValue as = Array $ fmap toNode as
+instance {-# OVERLAPPABLE #-} (FromAsdf a) => FromAsdf (NonEmpty a) where
+  parseValue val = do
+    as <- parseValue @[a] val
+    case as of
+      [] -> expected "NonEmpty List" val
+      (a : rest) -> pure (a :| rest)
+instance {-# OVERLAPPABLE #-} (ToAsdf a) => ToAsdf (NonEmpty a) where
+  toValue as = toValue $ NE.toList as
+
+
+instance (ToAsdf a, ToAsdf b) => ToAsdf (a, b) where
+  toValue (a, b) = Array [toNode a, toNode b]
+instance (FromAsdf a, FromAsdf b) => FromAsdf (a, b) where
+  parseValue = \case
+    Array [n1, n2] -> do
+      a <- parseValue n1.value
+      b <- parseValue n2.value
+      pure (a, b)
+    node -> expected "[a, b]" node
+
+
+instance (ToAsdf a, ToAsdf b, ToAsdf c) => ToAsdf (a, b, c) where
+  toValue (a, b, c) = Array [toNode a, toNode b, toNode c]
+instance (FromAsdf a, FromAsdf b, FromAsdf c) => FromAsdf (a, b, c) where
+  parseValue = \case
+    Array [na, nb, nc] -> do
+      a <- parseValue na.value
+      b <- parseValue nb.value
+      c <- parseValue nc.value
+      pure (a, b, c)
+    node -> expected "[a, b, c]" node
+
+
+instance (ToAsdf a, ToAsdf b, ToAsdf c, ToAsdf d) => ToAsdf (a, b, c, d) where
+  toValue (a, b, c, d) = Array [toNode a, toNode b, toNode c, toNode d]
+instance (FromAsdf a, FromAsdf b, FromAsdf c, FromAsdf d) => FromAsdf (a, b, c, d) where
+  parseValue = \case
+    Array [na, nb, nc, nd] -> do
+      a <- parseValue na.value
+      b <- parseValue nb.value
+      c <- parseValue nc.value
+      d <- parseValue nd.value
+      pure (a, b, c, d)
+    node -> expected "[a, b, c, d]" node
+
+
+-- they will always serialize to Array
+instance FromAsdf [Text] where
+  parseValue = parseAnyList
+instance FromAsdf [Int] where
+  parseValue = parseAnyList
+instance FromAsdf [Int8] where
+  parseValue = parseAnyList
+instance FromAsdf [Int16] where
+  parseValue = parseAnyList
+instance FromAsdf [Int32] where
+  parseValue = parseAnyList
+instance FromAsdf [Int64] where
+  parseValue = parseAnyList
+instance FromAsdf [Double] where
+  parseValue = parseAnyList
+
+
+-- | Flexibly parse lists from either Array or NDArray
+parseAnyList :: (FromAsdf a, FromNDArray [a], Parser :> es) => Value -> Eff es [a]
+parseAnyList = \case
+  Array ns -> mapM parseNode ns
+  NDArray dat -> fromNDArray dat
+  node -> expected "[Double]" node
+
+
+instance (FromAsdf a) => FromAsdf (Maybe a) where
+  parseValue = \case
+    Null -> pure Nothing
+    val -> Just <$> parseValue @a val
+instance (ToAsdf a) => ToAsdf (Maybe a) where
+  schema = maybe mempty schema
+  anchor = maybe Nothing anchor
+  toValue Nothing = Null
+  toValue (Just a) = toValue a
+
+
+instance (BinaryValue a, Prim a, AxesIndex ix) => FromAsdf (Array M.D ix a) where
+  parseValue = \case
+    NDArray a -> fromNDArray a
+    node -> expected "NDArray" node
+instance (BinaryValue a, IsDataType a, Prim a, AxesIndex ix, PutArray ix) => ToAsdf (Array M.D ix a) where
+  toValue as = NDArray $ ndArrayMassiv as
+
+
+instance ToAsdf Text where
+  toValue = String
+instance FromAsdf Text where
+  parseValue = \case
+    String t -> pure t
+    node -> expected "Text" node
+
+
+instance ToAsdf String where
+  toValue = String . pack
+instance FromAsdf String where
+  parseValue = \case
+    String t -> pure $ unpack t
+    node -> expected "Text" node
+
+
+instance ToAsdf Bool where
+  toValue = Bool
+instance FromAsdf Bool where
+  parseValue = \case
+    Bool b -> pure b
+    node -> expected "Bool" node
+
+
+instance ToAsdf Value where
+  toValue = id
+instance FromAsdf Value where
+  parseValue = pure
+
+
+instance ToAsdf Node where
+  toValue (Node _ _ val) = val
+instance FromAsdf Node where
+  parseValue val = pure $ Node mempty Nothing val
+
+
+instance ToAsdf Tree where
+  toValue (Tree o) = Object o
+instance FromAsdf Tree where
+  parseValue = \case
+    Object o -> pure $ Tree o
+    val -> expected "Object" val
+
+
+instance ToAsdf NDArrayData where
+  toValue = NDArray
+instance FromAsdf NDArrayData where
+  parseValue = \case
+    NDArray nda -> pure nda
+    node -> expected "NDArray" node
+
+
+instance ToAsdf DataType where
+  toValue Float64 = "float64"
+  toValue Float32 = "float32"
+  toValue Int64 = "int64"
+  toValue Int32 = "int32"
+  toValue Int16 = "int16"
+  toValue Int8 = "int8"
+  toValue Bool8 = "bool8"
+  toValue (Ucs4 n) = Array ["ucs4", fromValue $ Integer $ fromIntegral n]
+instance FromAsdf DataType where
+  parseValue = \case
+    String "float64" -> pure Float64
+    String "float32" -> pure Float32
+    String "int64" -> pure Int64
+    String "int32" -> pure Int32
+    String "int16" -> pure Int16
+    String "int8" -> pure Int8
+    String "bool8" -> pure Bool8
+    Array ["ucs4", Node _ _ (Integer n)] -> pure $ Ucs4 $ fromIntegral n
+    val -> expected "DataType" val
+
+
+instance ToAsdf ByteOrder where
+  toValue = \case
+    BigEndian -> "big"
+    LittleEndian -> "little"
+instance FromAsdf ByteOrder where
+  parseValue = \case
+    String "big" -> pure BigEndian
+    String "little" -> pure LittleEndian
+    node -> expected "ByteOrder" node
+
+
+instance ToAsdf (Axes Row) where
+  toValue (Axes as) = toValue as
+
+
+instance ToAsdf BlockSource where
+  toValue (BlockSource s) = toValue s
+
+
+instance ToAsdf UTCTime where
+  toValue t = String $ pack $ iso8601Show t
+instance FromAsdf UTCTime where
+  parseValue v = do
+    ts <- parseValue @String v
+    res <- runFail $ iso8601ParseM ts
+    case res of
+      Left e -> parseFail e
+      Right a -> pure a
+
+
+-- | Parse a node, ignoring the schema tag
+parseNode :: (FromAsdf a, Parser :> es) => Node -> Eff es a
+parseNode (Node _ _ v) = parseValue v
+
+
+{- | Parse a key from an 'Object'
+
+> instance FromAsdf User where
+>   parseValue = \case
+>     Object o -> do
+>       name <- o .: "name"
+>       age <- o .: "age"
+>       pure $ User{name, age}
+-}
+(.:) :: (FromAsdf a, Parser :> es) => Object -> Key -> Eff es a
+o .: k = do
+  case lookup k o of
+    Nothing -> parseFail $ "key " ++ show k ++ " not found"
+    Just node ->
+      parseAt (Child k) $ parseNode node
+
+
+-- | Parse an optional key from an 'Object'
+(.:?) :: (FromAsdf a, Parser :> es) => Object -> Key -> Eff es (Maybe a)
+o .:? k = do
+  case lookup k o of
+    Nothing -> pure Nothing
+    Just a ->
+      Just <$> do
+        parseAt (Child k) $ parseNode a
+
+
+{- | Parse a child at the given array index
+ -
+> instance FromAsdf Friends where
+>   parseValue = \case
+>     Array ns -> do
+>       best <- ns ! 0
+>       second <- ns ! 1
+>       other <- mapM parseNode ns
+>       pure $ Friends{best, second, other}
+-}
+(!) :: (FromAsdf a, Parser :> es) => [Node] -> Int -> Eff es a
+ns ! n = do
+  case ns !? n of
+    Nothing -> parseFail $ "Index " ++ show n ++ " not found"
+    Just node ->
+      parseAt (Index n) $ parseNode node
+
+
+-- | Generically serialize records to an 'Object'
+class GToObject f where
+  gToObject :: f p -> Object
+
+
+instance (GToObject f) => GToObject (M1 D c f) where
+  gToObject (M1 f) = gToObject f
+
+
+instance (GToObject f) => GToObject (M1 C c f) where
+  gToObject (M1 f) = gToObject f
+
+
+instance (GToObject f, GToObject g) => GToObject (f :*: g) where
+  gToObject (f :*: g) = gToObject f <> gToObject g
+
+
+instance (GToNode f, Selector s) => GToObject (M1 S s f) where
+  gToObject (M1 f) =
+    let s = selName (undefined :: M1 S s f p)
+     in [(pack s, gToNode f)]
+
+
+-- | Generically serialize record values to a 'Node'
+class GToNode f where
+  gToNode :: f p -> Node
+
+
+instance {-# OVERLAPPABLE #-} (ToAsdf a) => GToNode (K1 R a) where
+  gToNode (K1 a) = toNode a
+
+
+instance {-# OVERLAPPING #-} (ToAsdf a) => GToNode (K1 R (Maybe a)) where
+  gToNode (K1 a) = toNode a
+
+
+-- | Generically parse 'Object's into records
+class GParseObject f where
+  gParseObject :: (Parser :> es) => Object -> Eff es (f p)
+
+
+instance (GParseObject f) => GParseObject (M1 D c f) where
+  gParseObject o = M1 <$> gParseObject o
+
+
+instance (GParseObject f) => GParseObject (M1 C c f) where
+  gParseObject o = M1 <$> gParseObject o
+
+
+instance (GParseObject f, GParseObject g) => GParseObject (f :*: g) where
+  gParseObject o = do
+    f <- gParseObject o
+    g <- gParseObject o
+    pure $ f :*: g
+
+
+instance (GParseKey f, Selector s) => GParseObject (M1 S s f) where
+  gParseObject o = do
+    let k = pack $ selName (undefined :: M1 S s f p)
+    M1 <$> gParseKey o k
+
+
+-- | Generically parse a key from an 'Object' into a record value
+class GParseKey f where
+  gParseKey :: (Parser :> es) => Object -> Key -> Eff es (f p)
+
+
+instance {-# OVERLAPPABLE #-} (FromAsdf a) => GParseKey (K1 R a) where
+  gParseKey o k = K1 <$> o .: k
+
+
+instance {-# OVERLAPPABLE #-} (FromAsdf a) => GParseKey (K1 R (Maybe a)) where
+  gParseKey o k = K1 <$> o .:? k
diff --git a/src/Telescope/Asdf/Core.hs b/src/Telescope/Asdf/Core.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Asdf/Core.hs
@@ -0,0 +1,160 @@
+{-# LANGUAGE OverloadedLists #-}
+
+module Telescope.Asdf.Core where
+
+import Data.String (fromString)
+import Data.Text (Text)
+import Data.Version (showVersion)
+import Effectful
+import Effectful.Error.Static
+import GHC.Generics (Generic)
+import Paths_telescope (version)
+import Telescope.Asdf.Class
+import Telescope.Asdf.Error (AsdfError (..))
+import Telescope.Asdf.Node
+import Telescope.Data.Parser (expected)
+
+
+{- | VOUnit: https://www.ivoa.net/documents/VOUnits/20231215/REC-VOUnits-1.1.html
+ -
+Unrecognised units should be accepted by parsers, as long as they are parsed giving preference to the syntaxes and prefixes described here.
+-}
+data Unit
+  = Count
+  | Pixel
+  | Degrees
+  | Nanometers
+  | Unit Text
+  deriving (Eq)
+
+
+instance ToAsdf Unit where
+  schema _ = "!unit/unit-1.0.0"
+  toValue = \case
+    Count -> "count"
+    Pixel -> "pixel"
+    Degrees -> "deg"
+    Nanometers -> "nm"
+    (Unit t) -> String t
+instance FromAsdf Unit where
+  parseValue = \case
+    String "count" -> pure Count
+    String "deg" -> pure Degrees
+    String "pixel" -> pure Pixel
+    String "pix" -> pure Pixel
+    String "nm" -> pure Nanometers
+    String t -> pure $ Unit t
+    val -> expected "String" val
+
+
+-- | Tag a value with a 'Unit'
+data Quantity = Quantity
+  { unit :: Unit
+  , value :: Value
+  }
+  deriving (Generic)
+
+
+instance ToAsdf Quantity where
+  schema _ = "!unit/quantity-1.1.0"
+instance FromAsdf Quantity
+
+
+--
+-- -- TEST: this is probably index dependent
+-- data BoundingBox = BoundingBox Double Double
+--
+--
+-- instance ToAsdf BoundingBox where
+--   toValue (BoundingBox a b) =
+--     Array
+--       [ toNode $ Quantity Pixel (toValue a)
+--       , toNode $ Quantity Pixel (toValue b)
+--       ]
+--
+--
+-- instance FromAsdf BoundingBox where
+--   parseValue = \case
+--     Array [n1, n2] -> do
+--       BoundingBox <$> parseNode n1 <*> parseNode n2
+--     node -> expected "BoundingBox" node
+
+-- | Required Software node at the top-level
+data Software = Software
+  { author :: Maybe Text
+  , homepage :: Maybe Text
+  , name :: Text
+  , version :: Text
+  }
+  deriving (Show, Eq, Generic, FromAsdf)
+
+
+instance ToAsdf Software where
+  schema _ = "!core/software-1.0.0"
+
+
+-- | Root ASDF node
+data Asdf = Asdf
+  { history :: History
+  , library :: Software
+  , tree :: Tree
+  }
+
+
+instance ToAsdf Asdf where
+  schema _ = "!core/asdf-1.1.0"
+  toValue a =
+    let Tree tree = a.tree
+     in -- these two required fields are first, then merge keys from the tree
+        Object $
+          [ ("asdf_library", toNode a.library)
+          , ("history", toNode a.history)
+          ]
+            <> tree
+instance FromAsdf Asdf where
+  parseValue = \case
+    Object o -> do
+      library <- o .: "asdf_library"
+      history <- o .: "history"
+      let tree = Tree $ filter (not . isLibraryField) o
+      pure $ Asdf{history, library, tree}
+    val -> expected "Asdf" val
+   where
+    isLibraryField ("asdf_library", _) = True
+    isLibraryField ("history", _) = True
+    isLibraryField _ = False
+
+
+-- | Convert any ToAsdf into a raw Asdf document
+toAsdfDoc :: (ToAsdf a, Error AsdfError :> es) => a -> Eff es Asdf
+toAsdfDoc a =
+  case toValue a of
+    Object o -> do
+      let history = History []
+      let library = telescopeLibrary
+      pure $ Asdf{history, library, tree = Tree o}
+    value -> throwError $ EncodeError $ "Expected Top-level Tree Object, but got: " ++ show value
+ where
+  telescopeLibrary :: Software
+  telescopeLibrary =
+    Software
+      { author = Just "DKIST Data Center"
+      , homepage = Just "https://github.com/dkistdc/telescope.hs"
+      , name = "telescope.hs"
+      , version = fromString $ showVersion version
+      }
+
+
+data History = History
+  { extensions :: [ExtensionMetadata]
+  }
+  deriving (Show, Generic, FromAsdf, ToAsdf)
+
+
+data ExtensionMetadata = ExtensionMetadata
+  { extension_class :: Text
+  , software :: Software
+  }
+  deriving (Show, Generic, FromAsdf)
+instance ToAsdf ExtensionMetadata where
+  schema _ = "!core/extension_metadata-1.0.0"
diff --git a/src/Telescope/Asdf/Encoding.hs b/src/Telescope/Asdf/Encoding.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Asdf/Encoding.hs
@@ -0,0 +1,122 @@
+module Telescope.Asdf.Encoding where
+
+import Conduit
+import Data.Binary.Get
+import Data.ByteString (ByteString)
+import Data.ByteString.Lazy qualified as BL
+import Data.Function ((&))
+import Effectful
+import Effectful.Error.Static
+import Effectful.Reader.Dynamic
+import Effectful.Resource
+import Effectful.State.Static.Local
+import Telescope.Asdf.Class
+import Telescope.Asdf.Core
+import Telescope.Asdf.Encoding.File
+import Telescope.Asdf.Encoding.Stream
+import Telescope.Asdf.Error
+import Telescope.Asdf.Node
+import Telescope.Data.Parser (ParseError, runParser)
+import Text.Libyaml qualified as Yaml
+
+
+-- | Encode a 'ToAsdf' to a 'ByteString'
+encodeM :: (ToAsdf a, MonadIO m, MonadThrow m) => a -> m ByteString
+encodeM a = runAsdfM $ encode a
+
+
+-- | Encode a 'ToAsdf' to a 'ByteString'
+encode :: (ToAsdf a, IOE :> es, Error AsdfError :> es) => a -> Eff es ByteString
+encode a = do
+  asdf <- toAsdfDoc a
+  file <- encodeAsdf asdf
+  pure $ concatAsdfFile file
+
+
+-- | Encode an 'Asdf' document to a 'ByteString'
+encodeAsdf :: (IOE :> es, Error AsdfError :> es) => Asdf -> Eff es AsdfFile
+encodeAsdf a = do
+  (doc, bds) <- encodeNode (toNode a)
+  let tree = encodeTree doc
+  let blocks = fmap encodeBlock bds
+  let index = encodeIndex $ blockIndex tree blocks
+  pure $ AsdfFile{tree, blocks, index}
+
+
+-- | Low-level encoding of a node to a Yaml tree, without required headers, etc
+encodeNode :: (IOE :> es, Error AsdfError :> es) => Node -> Eff es (ByteString, [BlockData])
+encodeNode node = do
+  runYamlError $ encodeStream (yieldDocumentStream $ yieldNode node)
+
+
+-- | Create a stream of yaml events
+encodeStream :: (IOE :> es, Error AsdfError :> es) => ConduitT () Yaml.Event (Eff (State Anchors : State [BlockData] : Resource : es)) () -> Eff es (ByteString, [BlockData])
+encodeStream con = do
+  runStream $ con .| Yaml.encodeWith format
+ where
+  format =
+    Yaml.defaultFormatOptions
+      & Yaml.setTagRendering Yaml.renderUriTags
+      & Yaml.setWidth (Just 100)
+
+
+-- | Decode a 'ByteString' to a 'FromAsdf'
+decodeM :: (FromAsdf a, MonadIO m, MonadThrow m) => ByteString -> m a
+decodeM bs = runAsdfM $ decode bs
+
+
+-- | Decode a 'ByteString' to a 'FromAsdf'
+decodeEither :: forall a m. (FromAsdf a, MonadIO m) => ByteString -> m (Either String a)
+decodeEither bs = do
+  res <- liftIO $ runEff $ runErrorNoCallStack @AsdfError $ decode @a bs
+  pure $ either (Left . show) Right res
+
+
+-- | Decode a 'ByteString' to a 'FromAsdf'
+decode :: (FromAsdf a, IOE :> es, Error AsdfError :> es) => ByteString -> Eff es a
+decode bs = do
+  f <- splitAsdfFile bs
+  tree <- parseAsdfTree f.tree f.blocks
+  decodeFromTree tree
+
+
+-- | Decode a 'Tree' to a 'FromAsdf'
+decodeFromTree :: forall a es. (Error AsdfError :> es) => (FromAsdf a) => Tree -> Eff es a
+decodeFromTree (Tree o) = do
+  runParseError $ runParser $ parseValue @a (Object o)
+
+
+-- | Parse the asdf file parts into a 'Tree'
+parseAsdfTree :: (Error AsdfError :> es, IOE :> es) => Encoded Tree -> [Encoded Block] -> Eff es Tree
+parseAsdfTree etree eblks = do
+  (root, _) <- streamAsdfFile etree eblks
+  pure $ Tree root
+
+
+streamAsdfFile :: (Error AsdfError :> es, IOE :> es) => Encoded Tree -> [Encoded Block] -> Eff es (Object, Anchors)
+streamAsdfFile (Encoded inp) ebks = do
+  blocks <- mapM decodeBlock ebks
+  runParseError . runYamlError $ do
+    runReader blocks . runState @Anchors mempty . runResource . runConduit $ Yaml.decode inp .| sinkTree
+
+
+decodeBlock :: (Error AsdfError :> es) => Encoded Block -> Eff es BlockData
+decodeBlock (Encoded blk) = do
+  case runGetOrFail getBlock (BL.fromStrict blk) of
+    Left (_, num, err) -> throwError $ BlockError $ "at " ++ show num ++ ": " ++ err
+    Right ("", _, b) -> pure b
+    Right (rest, _, _) -> throwError $ BlockError $ "Unused bytes: " ++ show rest
+
+
+-- | Decode the BlockIndex
+decodeBlockIndex :: (Error AsdfError :> es, IOE :> es) => ByteString -> Eff es BlockIndex
+decodeBlockIndex inp =
+  runYamlError . runResource . runConduit $ Yaml.decode inp .| sinkIndex
+
+
+runYamlError :: (Error AsdfError :> es) => Eff (Error YamlError : es) a -> Eff es a
+runYamlError = runErrorNoCallStackWith @YamlError (throwError . YamlError . show)
+
+
+runParseError :: (Error AsdfError :> es) => Eff (Error ParseError : es) a -> Eff es a
+runParseError = runErrorNoCallStackWith @ParseError (throwError . ParseError . show)
diff --git a/src/Telescope/Asdf/Encoding/File.hs b/src/Telescope/Asdf/Encoding/File.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Asdf/Encoding/File.hs
@@ -0,0 +1,355 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Telescope.Asdf.Encoding.File where
+
+import Control.Monad (replicateM_)
+import Data.Binary.Get
+import Data.Binary.Put
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
+import Data.ByteString.Char8 qualified as BC
+import Data.ByteString.Lazy qualified as BL
+import Data.String (IsString)
+import Data.Word
+import Effectful
+import Effectful.Error.Static
+import Effectful.Fail
+import Effectful.NonDet
+import Effectful.State.Static.Local
+import Telescope.Asdf.Error
+import Telescope.Asdf.Node (Tree)
+
+
+-- | Split an encoded 'ByteString' into a 'Tree', '[Encoded Block]' and 'Encoded Index'
+splitAsdfFile :: (Error AsdfError :> es) => ByteString -> Eff es AsdfFile
+splitAsdfFile dat = do
+  res <- runFail $ evalState dat parseAsdfFile
+  case res of
+    Left e -> throwError $ ParseError e
+    Right a -> pure a
+
+
+-- | Lightweight first-pass parsing using 'State ByteString' instead of Parsec or similar
+parseAsdfFile :: (State ByteString :> es, Fail :> es) => Eff es AsdfFile
+parseAsdfFile = do
+  -- if it's empty, then give an error
+  tree <- onEmpty "tree" parseTree
+  blocks <- onEmpty "blocks" parseBlocks
+  index <- parseIndex
+  pure $ AsdfFile{tree, blocks, index}
+ where
+  onEmpty ex eff = do
+    res <- runNonDet OnEmptyKeep eff
+    case res of
+      Left _ -> do
+        inp <- get @ByteString
+        fail $ "Expected " ++ ex ++ " at " ++ show (BS.take 100 inp)
+      Right a -> pure a
+
+
+parseTree :: (State ByteString :> es, NonDet :> es) => Eff es (Encoded Tree)
+parseTree = do
+  t <- parseUntil blockMagicToken <|> parseUntil blockIndexHeader <|> remainingBytes
+  pure $ Encoded t
+
+
+parseIndex :: (State ByteString :> es) => Eff es (Encoded Index)
+parseIndex =
+  Encoded <$> get
+
+
+parseBlocks :: (State ByteString :> es, NonDet :> es) => Eff es [Encoded Block]
+parseBlocks = many parseBlock
+
+
+parseBlock :: (State ByteString :> es, NonDet :> es) => Eff es (Encoded Block)
+parseBlock = do
+  exactly blockMagicToken
+  b <- parseUntil blockMagicToken <|> parseUntil blockIndexHeader <|> nonEmpty
+  case b of
+    "" -> empty
+    _ -> pure $ Encoded $ blockMagicToken <> b
+
+
+exactly :: (State ByteString :> es, NonDet :> es) => ByteString -> Eff es ()
+exactly val = do
+  inp <- get @ByteString
+  if val `BS.isPrefixOf` inp
+    then do
+      put $ BS.drop (BS.length val) inp
+      pure ()
+    else empty
+
+
+parseUntil :: (State ByteString :> es, NonDet :> es) => ByteString -> Eff es ByteString
+parseUntil val = do
+  inp <- get @ByteString
+  let (before, rest) = BS.breakSubstring val inp
+  case rest of
+    "" -> empty
+    _ -> do
+      put rest
+      pure before
+
+
+nonEmpty :: (NonDet :> es, State ByteString :> es) => Eff es ByteString
+nonEmpty = do
+  b <- remainingBytes
+  case b of
+    "" -> empty
+    _ -> pure b
+
+
+remainingBytes :: (NonDet :> es, State ByteString :> es) => Eff es ByteString
+remainingBytes = do
+  inp <- get
+  put @ByteString ""
+  pure inp
+
+
+breakIndex :: (State ByteString :> es) => Eff es (Encoded Index)
+breakIndex = Encoded <$> get
+
+
+concatAsdfFile :: AsdfFile -> ByteString
+concatAsdfFile a =
+  mconcat [a.tree.bytes, blocks a.blocks, index a.index]
+ where
+  blocks :: [Encoded Block] -> ByteString
+  blocks ebks = mconcat $ fmap (.bytes) ebks
+  -- case mconcat $ fmap (.bytes) ebks of
+  --   "" -> ""
+  --   s -> s <> "\n"
+  index ix = ix.bytes
+
+
+encodeTree :: ByteString -> Encoded Tree
+encodeTree tr =
+  Encoded $ BS.intercalate "\n" (headers <> formatDoc tr) <> "\n" -- has a trailing newline
+ where
+  formatDoc doc = ["--- " <> doc, "..."]
+  headers = ["#ASDF 1.0.0", "#ASDF_STANDARD 1.5.0", "%YAML 1.1", tagDirective]
+  tagDirective = "%TAG ! tag:stsci.edu:asdf/"
+
+
+encodeBlocks :: [BlockData] -> [Encoded Block]
+encodeBlocks = fmap encodeBlock
+
+
+encodeBlock :: BlockData -> Encoded Block
+encodeBlock b =
+  Encoded $ BL.toStrict $ runPut $ putBlock b
+
+
+encodeIndex :: BlockIndex -> Encoded Index
+encodeIndex (BlockIndex ns) =
+  Encoded $ BS.intercalate "\n" $ ["#ASDF BLOCK INDEX", "%YAML 1.1", "---"] <> fmap indexEntry ns <> ["..."]
+ where
+  indexEntry n = "- " <> BC.pack (show n)
+
+
+data Index
+data Block
+
+
+-- | values that have been encoded to the file format: padding, etc
+newtype Encoded a = Encoded {bytes :: ByteString}
+  deriving (Show, Eq)
+  deriving newtype (IsString)
+
+
+-- | Decompressed block data
+newtype BlockData = BlockData {bytes :: ByteString}
+  deriving (Eq)
+
+
+newtype BlockSource = BlockSource Int
+  deriving (Eq)
+
+
+instance Show BlockData where
+  show (BlockData bs) = "BlockData " <> show (BS.length bs)
+
+
+data BlockHeader = BlockHeader
+  { headerSize :: Word16
+  , flags :: Word32
+  , compression :: Compression
+  , allocatedSize :: Word64
+  , usedSize :: Word64
+  , dataSize :: Word64
+  , checksum :: Checksum
+  }
+  deriving (Show, Eq)
+
+
+newtype BlockIndex = BlockIndex [Int]
+  deriving (Eq)
+
+
+data Compression
+  = NoCompression -- "\0\0\0\0"
+  | ZLib -- "zlib"
+  | BZip2 -- "bzp2"
+  deriving (Show, Eq)
+
+
+newtype Checksum = Checksum ByteString
+  deriving (Show, Eq)
+
+
+noChecksum :: Checksum
+noChecksum = Checksum $ BC.replicate 16 '0'
+
+
+data AsdfFile = AsdfFile
+  { tree :: Encoded Tree
+  , blocks :: [Encoded Block]
+  , index :: Encoded Index
+  }
+  deriving (Show, Eq)
+
+
+getBlock :: Get BlockData
+getBlock = do
+  h <- getBlockHeader
+  getBlockData h
+
+
+-- | Skip along blocks and create a list of all of them
+getBlocks :: Get [BlockData]
+getBlocks = do
+  isBlock <- checkMagicToken
+  if not isBlock
+    then pure []
+    else do
+      b <- getBlock
+      bs <- getBlocks
+      pure (b : bs)
+
+
+getBlockHeader :: Get BlockHeader
+getBlockHeader = do
+  expectMagicToken
+  headerSize <- label "header_size" getWord16be
+  start <- bytesRead
+
+  -- the remainder is inside the headerSize
+  flags <- label "flags" getWord32be -- 4
+  compression <- label "compression" getCompression -- 4
+  allocatedSize <- label "allocated_size" getWord64be -- 8
+  usedSize <- label "used_size" getWord64be -- 8
+  dataSize <- label "data_size" getWord64be -- 8
+  checksum <- label "checksum" getChecksum -- 2
+  end <- bytesRead
+
+  -- skip until the end of headerSize
+  let usedHead = fromIntegral $ end - start
+  skip $ fromIntegral headerSize - usedHead
+
+  pure $ BlockHeader{..}
+ where
+  getCompression = do
+    val <- getByteString 4
+    case val of
+      "\0\0\0\0" -> pure NoCompression
+      -- "zlib" -> pure ZLib
+      -- "bzp2" -> pure BZip2
+      _ -> fail $ "BlockHeader compression invalid, found " <> show val
+
+  getChecksum = Checksum <$> getByteString 16
+
+  expectMagicToken = do
+    m <- getMagicToken
+    case m of
+      Right a -> pure a
+      Left str -> fail $ "BlockHeader magic token invalid: " ++ show str
+
+
+putBlockHeader :: BlockHeader -> Put
+putBlockHeader h = do
+  putByteString blockMagicToken
+  putWord16be h.headerSize
+  size <- putHeaderContent
+  let emptyBytes = fromIntegral h.headerSize - size :: Int
+  replicateM_ emptyBytes $ putWord8 0x0
+ where
+  putCompression _ = putByteString "\0\0\0\0"
+  putChecksum (Checksum cs) = putByteString cs
+  putHeaderContent = do
+    let bs = runPut $ do
+          putWord32be 0 -- flags
+          putCompression NoCompression
+          putWord64be h.allocatedSize
+          putWord64be h.usedSize
+          putWord64be h.dataSize
+          putChecksum h.checksum
+    putLazyByteString bs
+    pure $ fromIntegral $ BL.length bs
+
+
+blockIndex :: Encoded Tree -> [Encoded Block] -> BlockIndex
+blockIndex (Encoded bytes) ebs =
+  let ns = scanl go (BS.length bytes) ebs
+   in BlockIndex $ take (length ns - 1) ns
+ where
+  go :: Int -> Encoded Block -> Int
+  go n eb = n + BS.length eb.bytes
+
+
+putBlock :: BlockData -> Put
+putBlock bd@(BlockData bs) = do
+  putBlockHeader $ blockHeader bd
+  putByteString bs
+
+
+blockHeader :: BlockData -> BlockHeader
+blockHeader (BlockData bs) =
+  let bytes = fromIntegral $ BS.length bs
+   in BlockHeader
+        { headerSize = 48 -- minimum allowed size. Our encoding uses fewer bytes than this
+        , compression = NoCompression
+        , allocatedSize = bytes
+        , usedSize = bytes
+        , dataSize = bytes
+        , checksum = noChecksum
+        , flags = 0
+        }
+
+
+getBlockData :: BlockHeader -> Get BlockData
+getBlockData h = do
+  -- LATER: handle compression
+  bytes <- getByteString $ fromIntegral h.usedSize
+  _empty <- getByteString $ fromIntegral $ h.allocatedSize - h.usedSize
+  pure $ BlockData bytes
+
+
+blockMagicToken :: ByteString
+blockMagicToken = BS.pack [0xd3, 0x42, 0x4c, 0x4b]
+
+
+blockIndexHeader :: ByteString
+blockIndexHeader = "#ASDF BLOCK INDEX"
+
+
+-- | Verify that the magic token is next without consuming any input
+checkMagicToken :: Get Bool
+checkMagicToken = do
+  emp <- isEmpty
+  if emp
+    then pure False
+    else do
+      eb <- lookAhead getMagicToken
+      pure $ either (const False) (const True) eb
+
+
+-- | consume the magic token if available
+getMagicToken :: Get (Either ByteString ())
+getMagicToken = do
+  -- this still fails if it is empty
+  str <- getByteString 4
+  pure $
+    if str == blockMagicToken
+      then Right ()
+      else Left str
diff --git a/src/Telescope/Asdf/Encoding/Stream.hs b/src/Telescope/Asdf/Encoding/Stream.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Asdf/Encoding/Stream.hs
@@ -0,0 +1,409 @@
+module Telescope.Asdf.Encoding.Stream where
+
+import Conduit
+import Data.ByteString (ByteString)
+import Data.Conduit.Combinators (peek)
+import Data.Conduit.Combinators qualified as C
+import Data.List ((!?))
+import Data.String (fromString)
+import Data.Text (pack, unpack)
+import Data.Text qualified as T
+import Data.Text.Encoding (decodeUtf8)
+import Data.Text.Encoding qualified as T
+import Effectful
+import Effectful.Error.Static
+import Effectful.NonDet
+import Effectful.Reader.Dynamic
+import Effectful.Resource
+import Effectful.State.Static.Local
+import Telescope.Asdf.Class hiding (anchor)
+import Telescope.Asdf.Encoding.File
+import Telescope.Asdf.NDArray (NDArrayData (..))
+import Telescope.Asdf.Node
+import Telescope.Data.Axes
+import Telescope.Data.Parser (runPureParser)
+import Text.Libyaml (Event (..), MappingStyle (..), SequenceStyle (..), Style (..), Tag (..))
+import Text.Libyaml qualified as Yaml
+import Text.Read (readMaybe)
+
+
+runStream :: (IOE :> es) => ConduitT () Void (Eff (State Anchors : State [BlockData] : Resource : es)) a -> Eff es (a, [BlockData])
+runStream con = do
+  runResource . runState @[BlockData] [] . evalState @Anchors mempty . runConduit $ con
+
+
+runStreamList :: (IOE :> es) => ConduitT () Event (Eff (State Anchors : State [BlockData] : Resource : es)) () -> Eff es [Event]
+runStreamList con = do
+  (res, _) <- runStream $ con .| sinkList
+  pure res
+
+
+yieldDocumentStream :: (State [BlockData] :> es, IOE :> es) => ConduitT a Event (Eff es) () -> ConduitT a Event (Eff es) ()
+yieldDocumentStream content = do
+  yield EventStreamStart
+  yield EventDocumentStart
+  content
+  yield EventDocumentEnd
+  yield EventStreamEnd
+
+
+yieldNode :: forall es a. (IOE :> es, State [BlockData] :> es, State Anchors :> es, Error YamlError :> es) => Node -> ConduitT a Event (Eff es) ()
+yieldNode node@(Node st anc val) = do
+  lift $ addNodeAnchor node
+  yieldValue val
+ where
+  yieldValue = \case
+    Object o -> yieldObject o
+    Array a -> yieldArray a
+    String "" -> yieldEmptyString
+    String s -> yieldScalar (T.encodeUtf8 s)
+    Integer n -> yieldNum n
+    NDArray nd -> yieldNDArray nd
+    Bool b -> yieldBool b
+    Number n -> yieldNum n
+    Null -> yieldScalar "~"
+    Reference r -> yieldObject [("$ref", toNode $ String (pack $ show r))]
+    Alias a -> yieldAlias a
+
+  anchor :: Yaml.Anchor
+  anchor =
+    case anc of
+      Nothing -> Nothing
+      (Just (Anchor a)) -> pure (unpack a)
+
+  tag = case st of
+    SchemaTag Nothing -> NoTag
+    SchemaTag (Just s) -> UriTag (unpack s)
+
+  yieldScalar s = yield $ EventScalar s tag Plain anchor
+  yieldEmptyString = yield $ EventScalar "" tag SingleQuoted anchor
+
+  yieldAlias (Anchor a) = do
+    _ <- lift $ resolveAnchor (Anchor a)
+    yield $ EventAlias (unpack a)
+
+  yieldNum :: (Num n, Show n) => n -> ConduitT a Event (Eff es) ()
+  yieldNum n = yieldScalar (T.encodeUtf8 $ pack $ show n)
+
+  yieldBool = \case
+    True -> yieldScalar "true"
+    False -> yieldScalar "false"
+
+  yieldObject :: [(Key, Node)] -> ConduitT a Event (Eff es) ()
+  yieldObject o = do
+    yield $ EventMappingStart tag blockStyle anchor
+    mapM_ yieldMapping o
+    yield EventMappingEnd
+   where
+    blockStyle
+      | any (isComplexNode . snd) o = BlockMapping
+      | otherwise = FlowMapping
+
+  yieldMapping :: (Key, Node) -> ConduitT a Event (Eff es) ()
+  yieldMapping (key, nd) = do
+    yield $ EventScalar (T.encodeUtf8 key) NoTag Plain Nothing
+    yieldNode nd
+
+  yieldArray :: [Node] -> ConduitT a Event (Eff es) ()
+  yieldArray ns = do
+    yield $ EventSequenceStart tag seqStyle anchor
+    mapM_ yieldNode ns
+    yield EventSequenceEnd
+   where
+    seqStyle
+      | any isComplexNode ns = BlockSequence
+      | otherwise = FlowSequence
+
+  yieldNDArray :: NDArrayData -> ConduitT a Event (Eff es) ()
+  yieldNDArray nd = do
+    src <- lift $ addBlock nd.bytes
+    yield $ EventMappingStart (UriTag "!core/ndarray-1.0.0") FlowMapping anchor
+    yieldMapping ("source", toNode src)
+    yieldMapping ("datatype", toNode nd.datatype)
+    yieldMapping ("shape", toNode nd.shape)
+    yieldMapping ("byteorder", toNode nd.byteorder)
+    yield EventMappingEnd
+
+
+addBlock :: (State [BlockData] :> es) => ByteString -> Eff es BlockSource
+addBlock bytes = do
+  blocks <- get @[BlockData]
+  put $ blocks <> [BlockData bytes]
+  pure $ BlockSource $ length blocks
+
+
+isComplexNode :: Node -> Bool
+isComplexNode (Node _ _ val) = isComplex val
+ where
+  isComplex = \case
+    Array _ -> True
+    Object _ -> True
+    NDArray _ -> True
+    _ -> False
+
+
+sinkTree :: (Error YamlError :> es, State Anchors :> es, Reader [BlockData] :> es) => ConduitT Yaml.Event o (Eff es) Object
+sinkTree = do
+  expect EventStreamStart
+  expect EventDocumentStart
+  Node _ _ v <- sinkNode
+  case v of
+    Object o -> pure o
+    _ -> lift $ throwError $ InvalidTree "Expected Object" v
+
+
+sinkNode :: (Error YamlError :> es, State Anchors :> es, Reader [BlockData] :> es) => ConduitT Yaml.Event o (Eff es) Node
+sinkNode = do
+  e <- event
+  node <- sinkByEvent e
+  lift $ addNodeAnchor node
+  pure node
+ where
+  sinkByEvent = \case
+    EventScalar s t _ a ->
+      lift $ parseScalar (fromString <$> a) s t
+    EventMappingStart tg _ a -> do
+      let stag = parseSchemaTag tg
+      maps <- sinkMappings
+      val <- lift $ fromMappings stag maps
+      pure $ Node stag (fromString <$> a) val
+    EventSequenceStart tg _ a -> do
+      ns <- sinkSequence
+      pure $ Node (parseSchemaTag tg) (fromString <$> a) $ Array ns
+    EventAlias a -> do
+      val <- lift $ resolveAnchor (Anchor $ pack a)
+      pure $ Node mempty Nothing val
+    ev -> lift $ throwError $ ExpectedEvent "Not Handled" ev
+
+  fromMappings :: forall es. (Error YamlError :> es, Reader [BlockData] :> es) => SchemaTag -> [(Key, Node)] -> Eff es Value
+  fromMappings stag maps = do
+    res <- runNonDet OnEmptyKeep (tryNDArray stag maps <|> tryReference maps) :: Eff es (Either CallStack Value)
+    case res of
+      Left _ -> pure $ Object maps
+      Right val -> pure val
+
+  tryNDArray :: (NonDet :> es, Error YamlError :> es, Reader [BlockData] :> es) => SchemaTag -> [(Key, Node)] -> Eff es Value
+  tryNDArray stag maps
+    | isNDArray stag = NDArray <$> ndArrayDataFromMaps maps
+    | otherwise = empty
+
+  tryReference :: (NonDet :> es, Error YamlError :> es) => [(Key, Node)] -> Eff es Value
+  tryReference maps = do
+    case lookup "$ref" maps of
+      Nothing -> empty
+      Just (Node _ _ (String s)) -> pure $ Reference $ jsonReference s
+      Just (Node _ _ value) -> throwError $ InvalidReference value
+
+
+resolveAnchor :: (State Anchors :> es, Error YamlError :> es) => Anchor -> Eff es Value
+resolveAnchor anc = do
+  Anchors anchors <- get @Anchors
+  case lookup anc anchors of
+    Nothing -> throwError $ AnchorUndefined anc (fmap fst anchors)
+    Just v -> pure v
+
+
+ndArrayDataFromMaps :: forall es. (Error YamlError :> es, Reader [BlockData] :> es) => [(Key, Node)] -> Eff es NDArrayData
+ndArrayDataFromMaps maps = do
+  bytes <- require "source" >>= findSource
+  datatype <- require "datatype" >>= parseDatatype
+  byteorder <- require "byteorder" >>= parseByteorder
+  shape <- require "shape" >>= parseShape
+  pure $ NDArrayData{bytes, datatype, byteorder, shape}
+ where
+  require key =
+    case lookup key maps of
+      Nothing -> throwError $ NDArrayMissingKey (unpack key)
+      Just (Node _ _ val) -> pure val
+
+  parseDatatype = parseLocal "DataType"
+  parseByteorder = parseLocal "ByteOrder"
+  parseShape val =
+    case val of
+      Array ns -> axesRowMajor <$> mapM (parseAxis . (.value)) ns
+      _ -> throwError $ NDArrayExpected "Shape" val
+
+  parseAxis val =
+    case val of
+      Integer n -> pure $ fromIntegral n
+      _ -> throwError $ NDArrayExpected "Shape Axis" val
+
+  findSource val =
+    case val of
+      Integer s -> do
+        blocks <- ask
+        case blocks !? fromIntegral s of
+          Nothing -> throwError $ NDArrayMissingBlock s
+          Just (BlockData b) -> pure b
+      _ -> throwError $ NDArrayExpected "Source" val
+
+  parseLocal :: (FromAsdf a, Error YamlError :> es) => String -> Value -> Eff es a
+  parseLocal expected val =
+    case runPureParser . runReader @Anchors mempty $ parseValue val of
+      Left _ -> throwError $ NDArrayExpected expected val
+      Right a -> pure a
+
+
+sinkMapping :: (Error YamlError :> es, Reader [BlockData] :> es, State Anchors :> es) => ConduitT Event o (Eff es) (Key, Node)
+sinkMapping = do
+  k <- sinkMapKey
+  v <- sinkNode
+  pure (k, v)
+ where
+  sinkMapKey =
+    event >>= \case
+      EventScalar s _ _ _ -> pure $ decodeUtf8 s
+      ev -> lift $ throwError $ ExpectedEvent "Scalar Key" ev
+
+
+-- we don't have to parse this into an object...
+sinkMappings :: (Error YamlError :> es, State Anchors :> es, Reader [BlockData] :> es) => ConduitT Event o (Eff es) [(Key, Node)]
+sinkMappings = do
+  sinkWhile (/= EventMappingEnd) sinkMapping
+
+
+-- oh, the event mapping ends aren't being consumed!
+sinkWhile :: (Event -> Bool) -> ConduitT Event o (Eff es) a -> ConduitT Event o (Eff es) [a]
+sinkWhile p parse = do
+  e <- peek
+  if maybe False p e
+    then do
+      a <- parse
+      as <- sinkWhile p parse
+      pure $ a : as
+    else do
+      -- consume the one we matched
+      C.drop 1
+      pure []
+
+
+sinkSequence :: (Error YamlError :> es, State Anchors :> es, Reader [BlockData] :> es) => ConduitT Event o (Eff es) [Node]
+sinkSequence = do
+  sinkWhile (/= EventSequenceEnd) sinkNode
+
+
+parseScalar :: (Error YamlError :> es) => Maybe Anchor -> ByteString -> Yaml.Tag -> Eff es Node
+parseScalar ma inp tg = byTag tg
+ where
+  byTag :: (Error YamlError :> es) => Yaml.Tag -> Eff es Node
+  byTag = \case
+    UriTag s -> throwEmpty "Any" $ Node (schemaTag s) ma <$> parseMulti inp
+    other -> do
+      val <- nonUriTagValue other
+      pure $ Node mempty ma val
+
+  nonUriTagValue :: (Error YamlError :> es) => Yaml.Tag -> Eff es Value
+  nonUriTagValue = \case
+    StrTag -> parseStr inp -- always succeeds
+    FloatTag -> throwEmpty "Float" $ parseFloat inp
+    IntTag -> throwEmpty "Int" $ parseInt inp
+    NullTag -> pure Null
+    BoolTag -> throwEmpty "Bool" $ parseBool inp
+    NoTag -> throwEmpty "Any" $ parseMulti inp
+    _ -> throwError $ InvalidScalarTag tg inp
+
+  parseBool "true" = pure $ Bool True
+  parseBool "false" = pure $ Bool False
+  parseBool _ = empty
+
+  parseStr s = pure $ String (decodeUtf8 s)
+
+  parseInt s = Integer <$> parseRead s
+
+  parseFloat s = Number <$> parseRead s
+
+  parseMulti s =
+    parseInt s <|> parseFloat s <|> parseBool s <|> parseStr s
+
+  throwEmpty :: (Error YamlError :> es) => String -> Eff (NonDet : es) a -> Eff es a
+  throwEmpty expt eff = do
+    ec <- runNonDet OnEmptyKeep eff
+    case ec of
+      Left _ -> throwError $ InvalidScalar expt tg inp
+      Right a -> pure a
+
+  parseRead :: (Read a, NonDet :> es) => ByteString -> Eff es a
+  parseRead s = do
+    maybe empty pure $ readMaybe (unpack $ decodeUtf8 s)
+
+
+-- | Await an event. Throw if out of input
+event :: (Error YamlError :> es) => ConduitT i o (Eff es) i
+event = do
+  e <- await
+  case e of
+    Nothing -> lift $ throwError NoInput
+    Just a -> pure a
+
+
+parseSchemaTag :: Tag -> SchemaTag
+parseSchemaTag (UriTag s) =
+  let t = pack s
+      mt = T.stripPrefix "tag:stsci.edu:asdf/" t
+   in SchemaTag (maybe (pure t) pure mt)
+parseSchemaTag _ = mempty
+
+
+isNDArray :: SchemaTag -> Bool
+isNDArray (SchemaTag Nothing) = False
+isNDArray (SchemaTag (Just t)) =
+  "core/ndarray" `T.isPrefixOf` t
+
+
+expect :: (Error YamlError :> es) => Event -> ConduitT Event o (Eff es) ()
+expect ex = expect' ("Exactly " ++ show ex) (== ex)
+
+
+expect' :: (Error YamlError :> es) => String -> (Event -> Bool) -> ConduitT Event o (Eff es) ()
+expect' ex p = do
+  e <- event
+  if p e
+    then pure ()
+    else lift $ throwError $ ExpectedEvent ex e
+
+
+data YamlError
+  = NoInput
+  | ExpectedEvent String Event
+  | InvalidScalar String Tag ByteString
+  | InvalidScalarTag Tag ByteString
+  | InvalidTree String Value
+  | NDArrayMissingKey String
+  | NDArrayMissingBlock Integer
+  | NDArrayExpected String Value
+  | InvalidReference Value
+  | AnchorUndefined Anchor [Anchor]
+  deriving (Show)
+
+
+sinkIndex :: (Error YamlError :> es) => ConduitT Event o (Eff es) BlockIndex
+sinkIndex = do
+  expect EventStreamStart
+  expect EventDocumentStart
+  expect' "EventSequenceStart" isSequence
+  ns <- sinkWhile (/= EventSequenceEnd) sinkIndexEntry
+  expect EventSequenceEnd
+  expect EventDocumentEnd
+  expect EventStreamEnd
+  pure $ BlockIndex ns
+ where
+  isSequence :: Event -> Bool
+  isSequence EventSequenceStart{} = True
+  isSequence _ = False
+
+  sinkIndexEntry :: (Error YamlError :> es) => ConduitT Event o (Eff es) Int
+  sinkIndexEntry = do
+    e <- event
+    case e of
+      EventScalar s t _ _ -> do
+        case readMaybe (unpack $ decodeUtf8 s) of
+          Just n -> pure n
+          Nothing -> lift $ throwError $ InvalidScalar "Int Index Entry" t s
+      _ -> lift $ throwError $ ExpectedEvent "Scalar Int" e
+
+
+addNodeAnchor :: (State Anchors :> es) => Node -> Eff es ()
+addNodeAnchor n =
+  case n.anchor of
+    Nothing -> pure ()
+    Just a -> modify (Anchors [(a, n.value)] <>)
diff --git a/src/Telescope/Asdf/Error.hs b/src/Telescope/Asdf/Error.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Asdf/Error.hs
@@ -0,0 +1,24 @@
+module Telescope.Asdf.Error where
+
+import Control.Monad.Catch (Exception, MonadThrow, throwM)
+import Effectful
+import Effectful.Error.Static
+
+
+data AsdfError
+  = YamlError String
+  | BlockError String
+  | ParseError String
+  | EncodeError String
+  deriving (Exception, Eq)
+
+
+instance Show AsdfError where
+  show (YamlError s) = "YamlError " ++ s
+  show (BlockError s) = "BlockError " ++ s
+  show (ParseError s) = "ParseError " ++ s
+  show (EncodeError s) = "EncodeError " ++ s
+
+
+runAsdfM :: (MonadIO m, MonadThrow m) => Eff [Error AsdfError, IOE] a -> m a
+runAsdfM = liftIO . runEff . runErrorNoCallStackWith @AsdfError throwM
diff --git a/src/Telescope/Asdf/GWCS.hs b/src/Telescope/Asdf/GWCS.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Asdf/GWCS.hs
@@ -0,0 +1,431 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DefaultSignatures #-}
+
+module Telescope.Asdf.GWCS where
+
+import Data.Kind (Type)
+import Data.List.NonEmpty (NonEmpty (..))
+import Data.List.NonEmpty qualified as NE
+import Data.Massiv.Array (Array, Ix2)
+import Data.Massiv.Array qualified as M
+import Data.String (IsString)
+import Data.Text (Text, pack)
+import Data.Text qualified as T
+import GHC.Generics
+import Telescope.Asdf
+import Telescope.Asdf.Core
+import Telescope.Data.WCS (WCSAxis (..))
+
+
+-- | GWCS pipelines consist of an input and output 'GWCSStep'
+data GWCS inp out = GWCS (GWCSStep inp) (GWCSStep out)
+
+
+instance (ToAsdf inp, ToAsdf out) => ToAsdf (GWCS inp out) where
+  schema _ = "tag:stsci.edu:gwcs/wcs-1.2.0"
+  toValue (GWCS inp out) =
+    Object
+      [ ("name", toNode $ String "")
+      , ("steps", toNode $ Array [toNode inp, toNode out])
+      ]
+
+
+-- | A step contains a frame (like 'CelestialFrame') and a 'Transform a b'
+data GWCSStep frame = GWCSStep
+  { frame :: frame
+  , transform :: Maybe Transformation
+  }
+  deriving (Generic)
+
+
+instance (ToAsdf frame) => ToAsdf (GWCSStep frame) where
+  schema _ = "tag:stsci.edu:gwcs/step-1.1.0"
+
+
+newtype AxisName = AxisName Text
+  deriving newtype (IsString, ToAsdf, Show, Semigroup, Eq)
+
+
+newtype AxisType = AxisType Text
+  deriving newtype (IsString)
+instance ToAsdf AxisType where
+  toValue (AxisType t) = String t
+
+
+data Pix a
+data Rot a
+
+
+instance (ToAxes a) => ToAxes (Pix a) where
+  toAxes = toAxes @a
+instance (ToAxes a) => ToAxes (Scale a) where
+  toAxes = fmap ("*" <>) (toAxes @a)
+instance (ToAxes a) => ToAxes (Shift a) where
+  toAxes = fmap ("+" <>) (toAxes @a)
+instance (ToAxes a) => ToAxes (Rot a) where
+  toAxes = fmap ("rot_" <>) (toAxes @a)
+instance (ToAxes a) => ToAxes (Linear a) where
+  toAxes = fmap ("lin_" <>) (toAxes @a)
+
+
+newtype Lon = Lon Float
+  deriving newtype (ToAsdf)
+newtype Lat = Lat Float
+  deriving newtype (ToAsdf)
+newtype LonPole = LonPole Float
+  deriving newtype (ToAsdf)
+
+
+-- | A 'Tranform' with the types stripped, and the axes recorded
+data Transformation = Transformation
+  { inputs :: [AxisName]
+  , outputs :: [AxisName]
+  , forward :: Forward
+  }
+  deriving (Show, Eq)
+
+
+instance ToAsdf Transformation where
+  schema t =
+    case t.forward of
+      Compose _ _ -> "!transform/compose-1.2.0"
+      Concat _ _ -> "!transform/concatenate-1.2.0"
+      Direct{schemaTag} -> schemaTag
+
+
+  toValue t =
+    inputFields <> case t.forward of
+      Compose a b -> Object [("forward", toNode [a, b])]
+      Concat a b -> Object [("forward", toNode [a, b])]
+      Direct{fields} -> fields
+   where
+    inputFields =
+      Object
+        [ ("inputs", toNode t.inputs)
+        , ("outputs", toNode t.outputs)
+        ]
+
+
+data Forward
+  = Compose Transformation Transformation
+  | Concat Transformation Transformation
+  | Direct {schemaTag :: SchemaTag, fields :: Value}
+  deriving (Show, Eq)
+
+
+{- | A Transform specifies how we manipulate a type in a pipeline
+
+> spatialTransform :: WCSAxis s X -> WCSAxis s Y -> Transform (Pix X, PixY) (Scale X, Scale Y)
+> spatialTransform wcsx wcsy =
+>   let dx = shift wcsx.crpix :: Transform (Pix X) (Shift X)
+>       dy = shift wcsy.crpix :: Transform (Pix Y) (Shift Y)
+>       xx = scale wcsx.cdelt :: Transform (Shift X) (Scale X)
+>       xy = scale wcsy.cdelt :: Transform (Shift Y) (Scale Y)
+>   in dx |> xx <&> dy |> xy
+-}
+data Transform b c = Transform
+  { transformation :: Transformation
+  }
+  deriving (Show)
+
+
+-- | Convert a type into a 'Transform' via 'ToAsdf' and 'ToAxes'
+transform :: forall a bs cs. (ToAsdf a, ToAxes bs, ToAxes cs) => a -> Transform bs cs
+transform a =
+  Transform
+    $ Transformation
+      (toAxes @bs)
+      (toAxes @cs)
+    $ Direct (schema a) (toValue a)
+
+
+-- | Compose two transforms
+(|>) :: forall b c d. (ToAxes b, ToAxes d) => Transform b c -> Transform c d -> Transform b d
+(Transform s) |> (Transform t) =
+  Transform
+    $ Transformation
+      (toAxes @b)
+      (toAxes @d)
+    $ Compose s t
+
+
+infixr 5 |>
+
+
+-- | Concatent two transforms
+(<&>)
+  :: forall (a :: Type) (b :: Type) (cs :: Type) (ds :: Type)
+   . (ToAxes (TConcat a cs), ToAxes (TConcat b ds))
+  => Transform a b
+  -> Transform cs ds
+  -> Transform (TConcat a cs) (TConcat b ds)
+Transform s <&> Transform t =
+  Transform
+    $ Transformation
+      (toAxes @(TConcat a cs))
+      (toAxes @(TConcat b ds))
+    $ Concat s t
+
+
+infixr 4 <&>
+
+
+data Direction
+  = Pix2Sky
+  | Native2Celestial
+  deriving (Show)
+
+
+instance ToAsdf Direction where
+  toValue = String . T.toLower . pack . show
+
+
+data Shift a = Shift Float deriving (Show, Eq)
+data Scale a = Scale Float deriving (Show, Eq)
+data Identity = Identity deriving (Show, Eq)
+data Intercept = Intercept Float deriving (Show, Eq)
+data Affine = Affine {matrix :: Array M.D Ix2 Float, translation :: (Float, Float)}
+data Projection = Projection Direction
+data Rotate3d = Rotate3d {direction :: Direction, phi :: Lon, theta :: Lat, psi :: LonPole}
+  deriving (Generic)
+data Linear a = Linear1d {intercept :: Float, slope :: Float}
+  deriving (Generic)
+
+
+instance ToAsdf Identity where
+  schema _ = "!transform/identity-1.2.0"
+  toValue _ = Object []
+
+
+instance ToAsdf (Linear a) where
+  schema _ = "!transform/linear1d-1.0.0"
+
+
+instance ToAsdf (Shift a) where
+  schema _ = "!transform/shift-1.2.0"
+  toValue (Shift d) =
+    Object [("offset", toNode d)]
+
+
+instance ToAsdf (Scale a) where
+  schema _ = "!transform/scale-1.2.0"
+  toValue (Scale d) =
+    Object [("factor", toNode d)]
+
+
+instance ToAsdf Projection where
+  schema _ = "!transform/gnomonic-1.2.0"
+  toValue (Projection d) =
+    Object [("direction", toNode d)]
+
+
+instance ToAsdf Rotate3d where
+  schema _ = "!transform/rotate3d-1.3.0"
+
+
+instance ToAsdf Affine where
+  schema _ = "!transform/affine-1.3.0"
+  toValue a =
+    let (tx, ty) = a.translation
+     in Object
+          [ ("matrix", toNode $ M.toLists a.matrix)
+          , ("translation", toNode [tx, ty])
+          ]
+
+
+-- Frames -----------------------------------------------
+
+data CoordinateFrame = CoordinateFrame
+  { name :: Text
+  , axes :: NonEmpty FrameAxis
+  }
+instance ToAsdf CoordinateFrame where
+  schema _ = "tag:stsci.edu:gwcs/frame-1.0.0"
+  toValue f =
+    Object $
+      [ ("name", toNode f.name)
+      , ("axes_type", toNode $ fmap (.axisType) f.axes)
+      ]
+        <> frameAxesObject f.axes
+
+
+data StokesFrame = StokesFrame
+  { name :: Text
+  , axisOrder :: Int
+  }
+instance ToAsdf StokesFrame where
+  schema _ = "tag:stsci.edu:gwcs/stokes_frame-1.0.0"
+  toValue f =
+    Object
+      [ ("name", toNode f.name)
+      , ("axes_order", toNode [f.axisOrder])
+      ]
+
+
+data SpectralFrame = SpectralFrame
+  { name :: Text
+  , axisOrder :: Int
+  }
+instance ToAsdf SpectralFrame where
+  schema _ = "tag:stsci.edu:gwcs/spectral_frame-1.0.0"
+  toValue f =
+    Object
+      [ ("name", toNode f.name)
+      , ("axes_names", toNode [String "wavelength"])
+      , ("axes_order", toNode [f.axisOrder])
+      , ("axis_physical_types", toNode [String "em.wl"])
+      , ("unit", toNode [Nanometers])
+      ]
+
+
+data CelestialFrame = CelestialFrame
+  { name :: Text
+  , axes :: NonEmpty FrameAxis
+  , referenceFrame :: ICRSFrame
+  }
+instance ToAsdf CelestialFrame where
+  schema _ = "tag:stsci.edu:gwcs/celestial_frame-1.0.0"
+  toValue f =
+    Object $
+      [ ("name", toNode f.name)
+      , ("reference_frame", toNode f.referenceFrame)
+      ]
+        <> frameAxesObject f.axes
+
+
+frameAxesObject :: NonEmpty FrameAxis -> Object
+frameAxesObject as =
+  -- doesn't include axes_type, only on CoorindateFrame
+  [ ("naxes", toNode $ NE.length as)
+  , ("axes_names", toNode axesNames)
+  , ("axes_order", toNode axesOrders)
+  , ("axes_physical_types", toNode axesPhysicalTypes)
+  , ("unit", toNode units)
+  ]
+ where
+  axesNames = fmap (.axisName) as
+  axesOrders = fmap (.axisOrder) as
+  axesPhysicalTypes = fmap (physicalType . (.axisType)) as
+  units = fmap (.unit) as
+  physicalType t = String "custom:" <> toValue t
+
+
+-- numAxes = NE.length as
+
+data ICRSFrame = ICRSFrame
+instance ToAsdf ICRSFrame where
+  schema _ = "tag:astropy.org:astropy/coordinates/frames/icrs-1.1.0"
+  toValue _ = Object [("frame_attributes", toNode $ Object mempty)]
+
+
+data FrameAxis = FrameAxis
+  { axisOrder :: Int
+  , axisName :: AxisName
+  , axisType :: AxisType
+  , unit :: Unit
+  }
+
+
+data CompositeFrame as = CompositeFrame as
+instance (ToAsdf as) => ToAsdf (CompositeFrame as) where
+  schema _ = "tag:stsci.edu:gwcs/composite_frame-1.0.0"
+  toValue (CompositeFrame as) =
+    Object
+      [ ("name", toNode $ String "CompositeFrame")
+      , ("frames", toNode as)
+      ]
+
+
+-- ToAxes -----------------------------------------------
+
+{- | Convert a type to named axes
+
+> data X deriving (Generic, ToAxes)
+> data Y
+> instance ToAxes Y where
+>   toAxes = ["y"]
+-}
+class ToAxes (as :: Type) where
+  toAxes :: [AxisName]
+  default toAxes :: (Generic as, GTypeName (Rep as)) => [AxisName]
+  toAxes = [AxisName $ pack $ gtypeName (from (undefined :: as))]
+
+
+instance ToAxes () where
+  toAxes = []
+instance (ToAxes a, ToAxes b) => ToAxes (a, b) where
+  toAxes = mconcat [toAxes @a, toAxes @b]
+instance (ToAxes a, ToAxes b, ToAxes c) => ToAxes (a, b, c) where
+  toAxes = mconcat [toAxes @a, toAxes @b, toAxes @c]
+instance (ToAxes a, ToAxes b, ToAxes c, ToAxes d) => ToAxes (a, b, c, d) where
+  toAxes = mconcat [toAxes @a, toAxes @b, toAxes @c, toAxes @d]
+
+
+-- Transforms -----------------------------------------------
+
+shift :: forall a f. (ToAxes (f a), ToAxes (Shift a)) => Float -> Transform (f a) (Shift a)
+shift d = transform $ Shift d
+
+
+scale :: forall a f. (ToAxes (f a), ToAxes (Scale a)) => Float -> Transform (f a) (Scale a)
+scale d = transform $ Scale d
+
+
+linear :: forall a. (ToAxes a) => Intercept -> Scale a -> Transform (Pix a) (Linear a)
+linear (Intercept dlt) (Scale scl) = transform $ Linear1d{intercept = dlt, slope = scl}
+
+
+rotate :: (ToAxes x, ToAxes y) => Array M.D Ix2 Float -> Transform (Linear x, Linear y) (Rot (x, y))
+rotate arr =
+  transform $ Affine arr (0, 0)
+
+
+project :: (ToAxes x, ToAxes y) => Direction -> Transform (Rot (x, y)) (Phi, Theta)
+project dir =
+  transform $ Projection dir
+
+
+celestial :: Lat -> Lon -> LonPole -> Transform (Phi, Theta) (Alpha, Delta)
+celestial lat lon pole =
+  transform $ Rotate3d{direction = Native2Celestial, theta = lat, phi = lon, psi = pole}
+
+
+data Phi deriving (Generic, ToAxes)
+data Theta deriving (Generic, ToAxes)
+data Alpha deriving (Generic, ToAxes)
+data Delta deriving (Generic, ToAxes)
+
+
+identity :: (ToAxes bs, ToAxes cs) => Transform bs cs
+identity = transform Identity
+
+
+-- WCS Transforms ---------------------------------------------------------
+
+wcsLinear :: (ToAxes axis) => WCSAxis alt axis -> Transform (Pix axis) (Linear axis)
+wcsLinear wcs = linear (wcsIntercept wcs) (Scale wcs.cdelt)
+
+
+-- the Y intercept
+wcsIntercept :: WCSAxis alt axis -> Intercept
+wcsIntercept w =
+  -- crpix is 1-indexed, need to switch to zero
+  Intercept $ w.crval - w.cdelt * (w.crpix - 1)
+
+
+-- | Generic NodeName
+class GTypeName f where
+  gtypeName :: f p -> String
+
+
+instance (Datatype d) => GTypeName (D1 d f) where
+  gtypeName = datatypeName
+
+
+type family TConcat a b where
+  TConcat (a, b, c) d = (a, b, c, d)
+  TConcat a (b, c, d) = (a, b, c, d)
+  TConcat (a, b) (c, d) = (a, b, c, d)
+  TConcat (a, b) c = (a, b, c)
+  TConcat a (b, c) = (a, b, c)
+  TConcat a b = (a, b)
diff --git a/src/Telescope/Asdf/NDArray.hs b/src/Telescope/Asdf/NDArray.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Asdf/NDArray.hs
@@ -0,0 +1,167 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+
+module Telescope.Asdf.NDArray
+  ( NDArrayData (..)
+  , FromNDArray (..)
+  , ToNDArray (..)
+  , DataType (..)
+  , IsDataType (..)
+  , parseGet
+  , ndArrayPut
+  , ndArrayMassiv
+  , parseMassiv
+  , parseNDArray
+  , ByteOrder (..)
+  , getUcs4
+  , putUcs4
+  , Parser
+  )
+where
+
+import Control.Monad (replicateM)
+import Control.Monad.Catch (try)
+import Data.Binary.Get hiding (getBytes)
+import Data.Binary.Put
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
+import Data.ByteString.Lazy qualified as BL
+import Data.Massiv.Array (Array, D, Prim, Sz (..))
+import Data.Massiv.Array qualified as M
+import Data.Text (Text)
+import Data.Text.Encoding qualified as T
+import Effectful
+import Telescope.Asdf.NDArray.Types
+import Telescope.Asdf.Node
+import Telescope.Data.Array
+import Telescope.Data.Axes
+import Telescope.Data.Binary
+import Telescope.Data.Parser
+
+
+-- import Telescope.Asdf.Node
+
+{- | Convert an 'NDArrayData' into a type
+https://asdf-standard.readthedocs.io/en/latest/generated/stsci.edu/asdf/core/ndarray-1.1.0.html
+-}
+class FromNDArray a where
+  fromNDArray :: (Parser :> es) => NDArrayData -> Eff es a
+
+
+{- | Convert a type to an 'NDArrayData'
+https://asdf-standard.readthedocs.io/en/latest/generated/stsci.edu/asdf/core/ndarray-1.1.0.html
+-}
+class ToNDArray a where
+  toNDArray :: a -> NDArrayData
+
+
+instance {-# OVERLAPPABLE #-} (BinaryValue a, IsDataType a) => ToNDArray [a] where
+  toNDArray = ndArrayPut shape putBytes
+   where
+    putBytes = mapM_ (put BigEndian)
+    shape as = axesRowMajor [length as]
+
+
+instance {-# OVERLAPPING #-} (BinaryValue a, IsDataType a) => ToNDArray [[a]] where
+  toNDArray = ndArrayPut shape putBytes
+   where
+    putBytes = mapM_ (mapM_ (put BigEndian))
+    shape = axesRowMajor . dimensions
+    dimensions [] = []
+    dimensions (r1 : rs) =
+      [length rs + 1, length r1]
+
+
+instance {-# OVERLAPPABLE #-} (BinaryValue a) => FromNDArray [a] where
+  fromNDArray arr = parseGet (getBytes arr.byteorder arr.shape) arr.bytes
+   where
+    getBytes bo axes = do
+      let num = totalItems axes
+      replicateM num (get bo)
+
+
+instance FromNDArray [Text] where
+  fromNDArray arr = do
+    n <- fromIntegral <$> ucs4Size arr.datatype
+    parseGet (replicateM (totalItems arr.shape) (getUcs4 arr.byteorder n)) arr.bytes
+   where
+    ucs4Size = \case
+      Ucs4 n -> pure n
+      dt -> expected "Ucs4" dt
+
+
+-- decode LittleEndian = T.decodeUtf32LE
+-- decode BigEndian = T.decodeUtf32BE
+
+instance {-# OVERLAPPING #-} (BinaryValue a) => FromNDArray [[a]] where
+  fromNDArray arr = parseGet (getBytes arr.shape) arr.bytes
+   where
+    getBytes (Axes rows) = mapM getRow rows
+    getRow n = replicateM n (get arr.byteorder)
+
+
+instance (BinaryValue a, Prim a, AxesIndex ix) => FromNDArray (Array D ix a) where
+  fromNDArray = parseMassiv
+
+
+instance (BinaryValue a, IsDataType a, Prim a, AxesIndex ix, PutArray ix) => ToNDArray (Array D ix a) where
+  toNDArray = ndArrayMassiv
+
+
+parseGet :: (Parser :> es) => Get a -> ByteString -> Eff es a
+parseGet gt bytes =
+  case runGetOrFail gt (BL.fromStrict bytes) of
+    Left (rest, nused, err) ->
+      parseFail $ "could not decode binary data at (" ++ show nused ++ ") (rest " ++ show (BL.length rest) ++ "): " ++ err
+    Right (_, _, a) -> pure a
+
+
+ndArrayPut :: forall a. (IsDataType a) => (a -> Axes Row) -> (a -> Put) -> a -> NDArrayData
+ndArrayPut toShape putA a =
+  let bytes = BL.toStrict $ runPut (putA a)
+   in NDArrayData{bytes, byteorder = BigEndian, datatype = dataType @a, shape = toShape a}
+
+
+ndArrayMassiv :: forall a ix. (IsDataType a, BinaryValue a, Prim a, AxesIndex ix, PutArray ix) => Array D ix a -> NDArrayData
+ndArrayMassiv arr =
+  let bytes = encodeArray arr
+      Sz ix = M.size arr
+      shape = indexAxes ix
+      datatype = dataType @a
+   in NDArrayData{bytes, shape, byteorder = BigEndian, datatype}
+
+
+parseMassiv :: (BinaryValue a, AxesIndex ix, Parser :> es) => NDArrayData -> Eff es (Array D ix a)
+parseMassiv nda = do
+  ea <- try $ decodeArrayOrder nda.byteorder nda.shape nda.bytes
+  case ea of
+    Left (e :: ArrayError) -> parseFail $ show e
+    Right a -> pure a
+
+
+putUcs4 :: Int -> Text -> Put
+putUcs4 n t = putByteString $ justifyUcs4 n $ T.encodeUtf32BE t
+
+
+getUcs4 :: ByteOrder -> Int -> Get Text
+getUcs4 bo n =
+  decodeUcs4 <$> getByteString (n * 4)
+ where
+  decodeUcs4 bs =
+    case bo of
+      BigEndian -> T.decodeUtf32BE . BS.dropWhileEnd (== 0x0) $ bs
+      LittleEndian -> T.decodeUtf32LE . BS.dropWhile (== 0x0) $ bs
+
+
+justifyUcs4 :: Int -> BS.ByteString -> BS.ByteString
+justifyUcs4 len bs =
+  let nulls = len * 4 - BS.length bs
+   in bs <> BS.replicate nulls 0x0
+
+
+parseNDArray :: (FromNDArray a, Parser :> es) => Value -> Eff es a
+parseNDArray val = do
+  dat <- ndarray val
+  fromNDArray dat
+ where
+  ndarray (NDArray a) = pure a
+  ndarray v = expected "NDArray" v
diff --git a/src/Telescope/Asdf/NDArray/Types.hs b/src/Telescope/Asdf/NDArray/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Asdf/NDArray/Types.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+
+module Telescope.Asdf.NDArray.Types where
+
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
+import GHC.Int (Int16, Int32, Int64)
+import Telescope.Data.Axes
+import Telescope.Data.Binary
+
+
+-- import Telescope.Asdf.Node
+
+{- | In-tree representation of an NDArray. You can parse a file as this and get it back. Not really what we want though
+but in haskell we can't easily just parse a multi-dimensional array
+we could do a simpler representation. Using an ADT
+-}
+data NDArrayData = NDArrayData
+  { bytes :: ByteString
+  , byteorder :: ByteOrder
+  , datatype :: DataType
+  , shape :: Axes Row
+  }
+  deriving (Eq)
+
+
+instance Show NDArrayData where
+  show nd = unwords ["NDArrayData", show (BS.length nd.bytes), show nd.byteorder, show nd.shape]
+
+
+data DataType
+  = Float64
+  | Float32
+  | Int64
+  | Int32
+  | Int16
+  | Int8
+  | Bool8
+  | Ucs4 Int
+  deriving (Show, Eq)
+
+
+class IsDataType a where
+  dataType :: DataType
+
+
+instance IsDataType Double where
+  dataType = Float64
+instance IsDataType Float where
+  dataType = Float32
+instance IsDataType Int64 where
+  dataType = Int64
+instance IsDataType Int32 where
+  dataType = Int32
+instance IsDataType Int16 where
+  dataType = Int16
+instance IsDataType Int8 where
+  dataType = Int8
+instance (IsDataType a) => IsDataType [a] where
+  dataType = dataType @a
diff --git a/src/Telescope/Asdf/Node.hs b/src/Telescope/Asdf/Node.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Asdf/Node.hs
@@ -0,0 +1,129 @@
+module Telescope.Asdf.Node where
+
+import Data.Maybe (fromMaybe)
+import Data.Scientific (Scientific)
+import Data.String (IsString (..))
+import Data.Text (Text, pack, unpack)
+import Data.Text qualified as T
+import Telescope.Asdf.NDArray.Types
+import Telescope.Data.Parser
+import Text.Read (readMaybe)
+
+
+-- | Specify a schema using 'schema' from 'ToAsdf'
+newtype SchemaTag = SchemaTag (Maybe Text)
+  deriving newtype (Monoid, Semigroup, Eq)
+
+
+instance Show SchemaTag where
+  show (SchemaTag Nothing) = ""
+  show (SchemaTag (Just t)) = unpack t ++ ":"
+
+
+schemaTag :: String -> SchemaTag
+schemaTag = SchemaTag . Just . pack
+
+
+instance IsString SchemaTag where
+  fromString s = SchemaTag (Just $ pack s)
+
+
+-- | A Node is a 'Value' with an optional 'SchemaTag' and 'Anchor'
+data Node = Node
+  { schema :: SchemaTag
+  , anchor :: Maybe Anchor
+  , value :: Value
+  }
+  deriving (Eq)
+
+
+instance Show Node where
+  show (Node st _ v) = show st ++ show v
+instance IsString Node where
+  fromString s = Node mempty Nothing $ String $ pack s
+
+
+-- | All allowed node values. We can't use Aeson's Value, because it doesn't support tags, binary data, or references
+data Value
+  = Bool !Bool
+  | Number !Scientific
+  | Integer !Integer
+  | String !Text
+  | -- | RawBinary !ByteString
+    NDArray !NDArrayData
+  | Array ![Node]
+  | Object !Object
+  | Reference !JSONReference
+  | Alias !Anchor
+  | Null
+  deriving (Show, Eq)
+
+
+instance IsString Value where
+  fromString = String . pack
+instance Semigroup Value where
+  String a <> String b = String $ a <> b
+  Array as <> Array bs = Array $ as <> bs
+  Object as <> Object bs = Object $ as <> bs
+  Null <> b = b
+  a <> Null = a
+  a <> _ = a
+instance Monoid Value where
+  mempty = Null
+
+
+type Key = Text
+type Object = [(Key, Node)]
+
+
+-- | Makes a node from a value
+fromValue :: Value -> Node
+fromValue = Node mempty Nothing
+
+
+-- | Root Object with all anchors resolved
+newtype Tree = Tree Object
+  deriving newtype (Semigroup, Monoid, Show)
+
+
+-- always $ref: uri#path
+data JSONReference = JSONReference
+  { uri :: Text
+  , pointer :: JSONPointer
+  }
+  deriving (Eq)
+instance Show JSONReference where
+  show ref = unpack ref.uri ++ show ref.pointer
+
+
+jsonReference :: Text -> JSONReference
+jsonReference t =
+  let (uri, rest) = T.breakOn "#" t
+   in JSONReference uri (jsonPointer rest)
+
+
+jsonPointer :: Text -> JSONPointer
+jsonPointer t =
+  let segs = filter (not . T.null) $ T.splitOn "/" $ T.dropWhile (== '#') t
+   in JSONPointer $ Path (fmap ref segs)
+ where
+  ref :: Text -> Ref
+  ref s = fromMaybe (Child s) $ do
+    n <- readMaybe (unpack s)
+    pure $ Index n
+
+
+newtype JSONPointer = JSONPointer Path
+  deriving (Eq)
+instance Show JSONPointer where
+  show (JSONPointer ps) = "#/" ++ show ps
+
+
+newtype Anchor = Anchor {anchor :: Text}
+  deriving (Eq)
+  deriving newtype (IsString, Show)
+
+
+newtype Anchors = Anchors [(Anchor, Value)]
+  deriving (Show, Eq)
+  deriving newtype (Monoid, Semigroup)
diff --git a/src/Telescope/Asdf/Reference.hs b/src/Telescope/Asdf/Reference.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Asdf/Reference.hs
@@ -0,0 +1,46 @@
+module Telescope.Asdf.Reference where
+
+import Data.List ((!?))
+import Data.Text (Text)
+import Effectful
+import Telescope.Asdf.NDArray
+import Telescope.Asdf.Node
+import Telescope.Data.Parser
+
+
+-- resolveInternalPointer :: forall a es. (FromAsdf a, Reader Tree :> es, Parser :> es) => JSONPointer -> Eff es a
+-- resolveInternalPointer point = do
+--   Node _ value <- findPointer point
+--   parseValue value
+
+-- | Parse a 'JSONPointer' from a 'Tree'
+findPointer :: forall es. (Parser :> es) => JSONPointer -> Tree -> Eff es Node
+findPointer (JSONPointer path) (Tree tree) = do
+  parseNext path (Node mempty Nothing (Object tree))
+ where
+  parseNext :: Path -> Node -> Eff es Node
+  parseNext (Path []) node = pure node
+  parseNext (Path (p : ps)) (Node _ _ val) = do
+    child <- parseSegment p val
+    parseNext (Path ps) child
+
+  parseSegment :: Ref -> Value -> Eff es Node
+  parseSegment (Child n) (Object o) = parseChild n o
+  parseSegment (Child n) node = missingPointer (Child n) node
+  parseSegment (Index n) (Array a) = parseIndex n a
+  parseSegment (Index n) node = missingPointer (Index n) node
+
+  parseChild :: Text -> Object -> Eff es Node
+  parseChild name o =
+    case lookup name o of
+      Nothing -> missingPointer (Child name) o
+      Just c -> pure c
+
+  parseIndex :: Int -> [Node] -> Eff es Node
+  parseIndex n a =
+    case a !? n of
+      Nothing -> missingPointer (Index n) a
+      Just c -> pure c
+
+  missingPointer :: (Show ex, Show at) => ex -> at -> Eff es Node
+  missingPointer expect at = parseFail $ "Could not locate pointer: " ++ show path ++ ". Expected " ++ show expect ++ " at " ++ show at
diff --git a/src/Telescope/Data/Array.hs b/src/Telescope/Data/Array.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Data/Array.hs
@@ -0,0 +1,194 @@
+module Telescope.Data.Array where
+
+import Control.Exception (throw)
+import Control.Monad.Catch
+import Data.Binary.Get (ByteOffset, runGetOrFail)
+import Data.Binary.Put (Put, runPut)
+import Data.ByteString qualified as BS
+import Data.ByteString.Lazy qualified as BL
+import Data.Massiv.Array (Array, Comp (..), D, Index, Ix1, Ix2 (..), Ix3, Ix4, Ix5, IxN (..), Lower, Prim, Source, Stream, Sz (..), Vector)
+import Data.Massiv.Array qualified as M
+import Data.Word (Word8)
+import Telescope.Data.Axes
+import Telescope.Data.Binary
+
+
+{- | Decode Big Endian encoded binary data into an Array of arbitrary dimensions 'ix' by specifying the 'Axes' 'Row'
+
+>>> decodeArray @Ix2 @Float [3, 2] input
+Array P Seq (Sz (2 :. 3))
+  [ [ 1.0, 2.0, 3.0 ]
+  , [ 4.0, 5.0, 6.0 ]
+  ]
+-}
+decodeArray
+  :: forall ix a m
+   . (AxesIndex ix, Prim a, BinaryValue a, MonadThrow m, MonadCatch m)
+  => Axes Row
+  -> BS.ByteString
+  -> m (Array D ix a)
+decodeArray = decodeArrayOrder BigEndian
+
+
+{- | Encode an Array as a Lazy ByteString based on the type of the element 'a'
+
+>>> myArray = decodeArray @Ix2 @Float BPFloat [3, 2] input
+>>> output = encodeArray myArray
+-}
+encodeArray
+  :: (Source r a, Stream r Ix1 a, PutArray ix, BinaryValue a, Prim a)
+  => Array r ix a
+  -> BS.ByteString
+encodeArray = BL.toStrict . runPut . putArray BigEndian
+
+
+{- | Decode binary data into an Array of arbitrary dimensions 'ix' by specifying the 'Axes' 'Row' and the 'ByteOrder'
+
+>>> decodeArrayOrder @Ix2 @Float BigEndian [3, 2] input
+Array P Seq (Sz (2 :. 3))
+  [ [ 1.0, 2.0, 3.0 ]
+  , [ 4.0, 5.0, 6.0 ]
+  ]
+-}
+decodeArrayOrder
+  :: forall ix a m
+   . (AxesIndex ix, BinaryValue a, MonadThrow m, MonadCatch m)
+  => ByteOrder
+  -> Axes Row
+  -> BS.ByteString
+  -> m (Array D ix a)
+decodeArrayOrder bo as inp = do
+  fromVector as $ decodeVector @a Par bo inp
+
+
+-- | Decode binary data into as a 1d Array
+decodeVector
+  :: forall a
+   . (BinaryValue a)
+  => Comp
+  -> ByteOrder
+  -> BS.ByteString
+  -> Vector D a
+decodeVector c bo inp =
+  let v = parseWordVector inp
+   in M.makeArray c (arraySize v) (valueAt v)
+ where
+  numBytes = byteSize @a
+
+  arraySize v =
+    let Sz s = M.size v
+     in Sz $ s `div` numBytes
+
+  valueAt :: Vector D Word8 -> Ix1 -> a
+  valueAt v ix =
+    fromWords $ wordsAt v ix
+
+  wordsAt :: Vector D Word8 -> Ix1 -> [Word8]
+  wordsAt v ix =
+    M.toList $ M.slice (ix * numBytes) (Sz numBytes) v
+
+  parseWordVector :: BS.ByteString -> Vector D Word8
+  parseWordVector = M.fromByteString c
+
+  -- this should never actually fail
+  fromWords :: [Word8] -> a
+  fromWords ws =
+    case runGetOrFail (get bo) (BL.pack ws) of
+      Left (ip, byts, e) -> throw $ BinaryParseError byts (e <> " " <> show ip <> show ws)
+      Right (_, _, a) -> a
+
+
+-- | Resize a Vector into an Array
+fromVector
+  :: forall ix a m
+   . (AxesIndex ix, MonadThrow m, MonadCatch m)
+  => Axes Row
+  -> Vector D a
+  -> m (Array D ix a)
+fromVector as v = do
+  ix <- axesIndex as
+  ea <- try $ M.resizeM (Sz ix) v
+  case ea of
+    Left (e :: M.SizeException) -> throwM $ ResizeMismatch (show e)
+    Right a -> pure a
+
+
+data ArrayError
+  = BinaryParseError !ByteOffset String
+  | AxesMismatch !(Axes Row)
+  | ResizeMismatch String
+  deriving (Show, Exception)
+
+
+-- | Convert between an 'Index' and 'Axes' 'Row'
+class (Index ix) => AxesIndex ix where
+  axesIndex :: (MonadThrow m) => Axes Row -> m ix
+  indexAxes :: ix -> Axes Row
+
+
+instance AxesIndex Ix1 where
+  axesIndex (Axes [i]) = pure i
+  axesIndex as = throwM $ AxesMismatch as
+  indexAxes n = Axes [n]
+
+
+instance AxesIndex Ix2 where
+  axesIndex (Axes [c, r]) = do
+    ix1 <- axesIndex $ Axes [r]
+    pure $ c :. ix1
+  axesIndex as = throwM $ AxesMismatch as
+  indexAxes (c :. r) = Axes [c, r]
+
+
+instance AxesIndex Ix3 where
+  axesIndex = axesIndexN
+  indexAxes = indexAxesN
+
+
+instance AxesIndex Ix4 where
+  axesIndex = axesIndexN
+  indexAxes = indexAxesN
+
+
+instance AxesIndex Ix5 where
+  axesIndex = axesIndexN
+  indexAxes = indexAxesN
+
+
+-- | Encode an 'Array' of dimensions up to 'Ix5'
+class PutArray ix where
+  putArray
+    :: (BinaryValue a, Source r a, Stream r Ix1 a, Prim a)
+    => ByteOrder
+    -> Array r ix a
+    -> Put
+
+
+instance PutArray Ix1 where
+  putArray bo = M.sfoldl (\b a -> b <> put bo a) mempty
+instance PutArray Ix2 where
+  putArray = M.foldOuterSlice . putArray
+instance PutArray Ix3 where
+  putArray = M.foldOuterSlice . putArray
+instance PutArray Ix4 where
+  putArray = M.foldOuterSlice . putArray
+instance PutArray Ix5 where
+  putArray = M.foldOuterSlice . putArray
+
+
+axesIndexN :: (AxesIndex (Lower (IxN n))) => (MonadThrow m) => Axes Row -> m (IxN n)
+axesIndexN (Axes (a : as)) = do
+  ixl <- axesIndex (Axes as)
+  pure $ a :> ixl
+axesIndexN as = throwM $ AxesMismatch as
+
+
+indexAxesN :: (AxesIndex (Lower (IxN n))) => IxN n -> Axes Row
+indexAxesN (d :> ix) =
+  let Axes ax = indexAxes ix
+   in Axes $ d : ax
+
+
+-- | Get the Axes for a given array size
+sizeAxes :: (AxesIndex ix, Index ix) => Sz ix -> Axes Column
+sizeAxes (Sz ix) = toColumnMajor $ indexAxes ix
diff --git a/src/Telescope/Data/Axes.hs b/src/Telescope/Data/Axes.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Data/Axes.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+
+module Telescope.Data.Axes where
+
+import GHC.IsList (IsList (..))
+import GHC.TypeLits
+
+
+type Axis = Int
+
+
+newtype Axes (a :: Major) = Axes {axes :: [Axis]}
+  deriving (Show, Eq)
+
+
+data Major = Row | Column
+
+
+axesRowMajor :: [Axis] -> Axes Row
+axesRowMajor = Axes
+
+
+axesColumnMajor :: [Axis] -> Axes Column
+axesColumnMajor = Axes
+
+
+toRowMajor :: Axes Column -> Axes Row
+toRowMajor (Axes as) = Axes (reverse as)
+
+
+toColumnMajor :: Axes Row -> Axes Column
+toColumnMajor (Axes as) = Axes (reverse as)
+
+
+totalItems :: Axes a -> Int
+totalItems (Axes as) = product as
+
+
+instance IsList (Axes Row) where
+  type Item (Axes Row) = Axis
+  fromList = Axes
+  toList (Axes ax) = ax
+
+
+{- | Specify which numbered axis a type represents
+
+> data X
+> instance AxisOrder X where
+>   axisN = 1
+>
+> data Y
+> instance AxisOrder Y where
+>   axisN = 2
+-}
+class AxisOrder ax where
+  axisN :: Natural
diff --git a/src/Telescope/Data/Binary.hs b/src/Telescope/Data/Binary.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Data/Binary.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+
+module Telescope.Data.Binary
+  ( BinaryValue (..)
+  , ByteOrder (..)
+  ) where
+
+import Data.Binary.Get
+import Data.Binary.Put
+import GHC.Int
+import System.ByteOrder (ByteOrder (..))
+
+
+-- | Primitive types that can be serialized as Big or Little Endian
+class BinaryValue a where
+  byteSize :: Int
+  put :: ByteOrder -> a -> Put
+  get :: ByteOrder -> Get a
+
+
+instance BinaryValue Int8 where
+  byteSize = 1
+  put _ = putInt8
+  get _ = getInt8
+
+
+instance BinaryValue Int16 where
+  byteSize = 2
+  put BigEndian = putInt16be
+  put LittleEndian = putInt16le
+  get BigEndian = getInt16be
+  get LittleEndian = getInt16le
+
+
+instance BinaryValue Int32 where
+  byteSize = 4
+  put BigEndian = putInt32be
+  put LittleEndian = putInt32le
+  get BigEndian = getInt32be
+  get LittleEndian = getInt32le
+
+
+instance BinaryValue Int64 where
+  byteSize = 8
+  put BigEndian = putInt64be
+  put LittleEndian = putInt64le
+  get BigEndian = getInt64be
+  get LittleEndian = getInt64le
+
+
+instance BinaryValue Int where
+  byteSize = byteSize @Int64
+  put bo a = put @Int64 bo (fromIntegral a)
+  get bo = fromIntegral <$> get @Int64 bo
+
+
+instance BinaryValue Float where
+  byteSize = 4
+  put BigEndian = putFloatbe
+  put LittleEndian = putFloatle
+  get BigEndian = getFloatbe
+  get LittleEndian = getFloatle
+
+
+instance BinaryValue Double where
+  byteSize = 8
+  put BigEndian = putDoublebe
+  put LittleEndian = putDoublele
+  get BigEndian = getDoublebe
+  get LittleEndian = getDoublele
diff --git a/src/Telescope/Data/KnownText.hs b/src/Telescope/Data/KnownText.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Data/KnownText.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+
+module Telescope.Data.KnownText where
+
+import Data.Proxy (Proxy (..))
+import Data.Text
+import GHC.TypeLits
+
+
+-- | Types that have a textual representation, like 'KnownSymbol', but for any 'Type'
+class KnownText a where
+  knownText :: Text
+
+
+instance (KnownSymbol s) => KnownText s where
+  knownText = pack $ symbolVal @s Proxy
diff --git a/src/Telescope/Data/Parser.hs b/src/Telescope/Data/Parser.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Data/Parser.hs
@@ -0,0 +1,88 @@
+module Telescope.Data.Parser where
+
+import Control.Monad.Catch (Exception)
+import Data.List (intercalate)
+import Data.Text (Text, unpack)
+import Effectful
+import Effectful.Dispatch.Dynamic
+import Effectful.Error.Static
+import Effectful.Reader.Static
+
+
+data Parser :: Effect where
+  ParseFail :: String -> Parser m a
+  PathAdd :: Ref -> m a -> Parser m a
+
+
+type instance DispatchOf Parser = 'Dynamic
+
+
+runParser
+  :: (Error ParseError :> es)
+  => Eff (Parser : es) a
+  -> Eff es a
+runParser = reinterpret (runReader @Path mempty) $ \env -> \case
+  ParseFail e -> do
+    path <- ask @Path
+    throwError $ ParseFailure path e
+  PathAdd p m -> do
+    -- copied from Effectful.Reader.Dynamic
+    localSeqUnlift env $ \unlift -> local (<> Path [p]) (unlift m)
+
+
+runPureParser :: Eff '[Parser, Error ParseError] a -> Either ParseError a
+runPureParser eff = runPureEff . runErrorNoCallStack @ParseError $ runParser eff
+
+
+data ParseError
+  = ParseFailure Path String
+  deriving (Exception, Eq)
+
+
+instance Show ParseError where
+  show (ParseFailure path s) =
+    "at " ++ show path ++ "\n ! " ++ s
+
+
+-- | Tracks the location of the parser in the document for error messages
+newtype Path = Path [Ref]
+  deriving (Eq)
+  deriving newtype (Semigroup, Monoid)
+
+
+instance Show Path where
+  show (Path ps) =
+    intercalate "/" (fmap show ps)
+
+
+data Ref
+  = Child Text
+  | Index Int
+  deriving (Eq)
+
+
+instance Show Ref where
+  show (Child c) = unpack c
+  show (Index n) = show n
+
+
+{- | Easy error message when we expect a particular type:
+
+> instance FromKeyword Int where
+>   parseKeywordValue = \case
+>     Integer n -> pure n
+>     v -> expected "Integer" v
+-}
+expected :: (Show value, Parser :> es) => String -> value -> Eff es a
+expected ex n =
+  parseFail $ "Expected " ++ ex ++ ", but got: " ++ show n
+
+
+parseFail :: (Parser :> es) => String -> Eff es a
+parseFail e = send $ ParseFail e
+
+
+-- | Add a child to the parsing 'Path'
+parseAt :: (Parser :> es) => Ref -> Eff es a -> Eff es a
+parseAt p parse = do
+  send $ PathAdd p parse
diff --git a/src/Telescope/Data/WCS.hs b/src/Telescope/Data/WCS.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Data/WCS.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+
+module Telescope.Data.WCS where
+
+import Data.Text
+import GHC.Generics (Generic)
+import Telescope.Data.Axes (AxisOrder (..))
+import Telescope.Data.KnownText
+
+
+newtype CUnit = CUnit Text deriving (Eq, Show)
+newtype CType = CType Text deriving (Eq, Show)
+
+
+{- | Typed WCS Axes
+
+> data X
+> data Y
+>
+> myFunction :: WCSAxis 'WCSMain X -> WCSAxis 'WCSMain Y -> Header
+> myFunction wcsx wcsy =
+>   toHeader wcsx <> toHeader wcsy
+-}
+data WCSAxis (alt :: WCSAlt) axis = WCSAxis
+  { ctype :: CType
+  , cunit :: CUnit
+  , crpix :: Float
+  , crval :: Float
+  , cdelt :: Float
+  }
+  deriving (Generic, Eq, Show)
+
+
+-- | WCSAlt options
+data WCSAlt
+  = WCSMain
+  | A
+  | B
+
+
+instance KnownText WCSMain where
+  knownText = ""
+instance KnownText A where
+  knownText = "A"
+instance KnownText B where
+  knownText = "B"
+
+
+-- | Converts a wcs keyword like "ctype" to "CTYPE1A" for header parsing
+toWCSAxisKey :: forall alt ax. (KnownText alt, AxisOrder ax) => Text -> Text
+toWCSAxisKey = addAlt . addAxisN
+ where
+  addAxisN k = k <> pack (show (axisN @ax))
+  addAlt k = k <> (knownText @alt)
diff --git a/src/Telescope/Fits.hs b/src/Telescope/Fits.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Fits.hs
@@ -0,0 +1,90 @@
+{- |
+Module:      Telescope.Fits
+Copyright:   (c) 2024 Sean Hess
+License:     BSD3
+Maintainer:  Sean Hess <shess@nso.edu>
+Stability:   experimental
+Portability: portable
+
+Read, Generate, and Write FITS (Flexible Image Transport System) files
+
+@
+import Data.ByteString qualified as BS
+import Telescope.Fits
+
+test :: IO ()
+test = do
+  inp <- BS.readFile "samples/simple2x3.fits"
+  f <- decode inp
+  print f.primaryHDU.dataArray.axes
+  print f.primaryHDU.dataArray.bitpix
+  print $ lookupKeyword \"BTYPE\" f.primaryHDU.header
+
+  a <- decodeArray @Ix2 @Int f.primaryHDU.dataArray
+  print $ size a
+  print $ a !> 0
+@
+-}
+module Telescope.Fits
+  ( decode
+  , encode
+  , decodeDataArray
+  , encodeDataArray
+
+    -- * Headers
+  , lookupKeyword
+  , Header
+  , Value (..)
+  , LogicalConstant (..)
+
+    -- * Parsing Headers
+  , FromHeader (..)
+  , FromKeyword (..)
+
+    -- * Creating Headers
+  , ToKeyword (..)
+  , ToHeader (..)
+  , Parser
+
+    -- * Types
+  , Fits (..)
+  , PrimaryHDU (..)
+  , ImageHDU (..)
+  , BinTableHDU (..)
+  , DataArray (..)
+  , Extension (..)
+  , Axis
+  , Axes
+  , Major (..)
+  , BitPix (..)
+
+    -- * Generate
+  , addComment
+  , keyword
+  , dataArray
+  , emptyDataArray
+
+    -- * Exports from Data.Massiv.Array
+  , Array
+  , Ix1
+  , Ix2
+  , Ix3
+  , Ix4
+  , Ix5
+  , size
+  , (!>)
+  , (!?>)
+  , (<!)
+  , (<!?)
+  , (<!>)
+  , Dim (..)
+  -- , test
+  ) where
+
+import Data.Massiv.Array (Array, Dim (..), Ix1, Ix2, Ix3, Ix4, Ix5, size, (!>), (!?>), (<!), (<!>), (<!?))
+import Telescope.Data.Parser (Parser)
+import Telescope.Fits.DataArray
+import Telescope.Fits.Encoding
+import Telescope.Fits.Header (FromHeader (..), FromKeyword (..), ToHeader (..), ToKeyword (..), addComment, keyword, lookupKeyword)
+import Telescope.Fits.Types
+
diff --git a/src/Telescope/Fits/Checksum.hs b/src/Telescope/Fits/Checksum.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Fits/Checksum.hs
@@ -0,0 +1,66 @@
+module Telescope.Fits.Checksum where
+
+import Data.Bits (complement, shiftR, (.&.))
+import Data.ByteString.Internal
+import Data.Fits (Value (..))
+import Data.Text (Text, pack)
+import Data.Word
+import Foreign.C.String
+import Foreign.C.Types
+import Foreign.ForeignPtr (withForeignPtr)
+import Foreign.Ptr
+import GHC.IO
+
+
+-- | Generate the Checksum per the FITS spec
+checksum :: ByteString -> Checksum
+checksum bs = unsafePerformIO $ do
+  let (fptr, offset, len) = toForeignPtr bs
+  withForeignPtr fptr $ \ptr -> do
+    ci <- c_checksum (ptr `plusPtr` offset) (fromIntegral len)
+    pure $ Checksum $ fromIntegral ci
+
+
+-- | Encode the Checksum as ASCII chars per FITS spec
+encodeChecksum :: Checksum -> Text
+encodeChecksum (Checksum csum) =
+  unsafePerformIO $ do
+    let comp = complement csum
+    let str = replicate 16 ' '
+    out <- withCString str $ \cs -> do
+      c_char_encode (fromIntegral comp) cs
+      peekCString cs
+    pure $ pack out
+
+
+foreign import ccall "checksum" c_checksum :: Ptr CChar -> CInt -> IO CUInt
+
+
+newtype Checksum = Checksum Word32
+  deriving (Eq, Show)
+
+
+instance Semigroup Checksum where
+  Checksum w1 <> Checksum w2 = Checksum (add1s w1 w2)
+
+
+checksumValue :: Checksum -> Value
+checksumValue (Checksum s) = String (pack (show s))
+
+
+foreign import ccall "char_encode" c_char_encode :: CUInt -> CString -> IO ()
+
+
+add1s :: Word32 -> Word32 -> Word32
+add1s x y =
+  let
+    sum64 = (+) @Word64 (fromIntegral x) (fromIntegral y)
+    result =
+      if sum64 > maxWord32
+        then (sum64 .&. maxWord32) + (sum64 `shiftR` 32)
+        else sum64
+   in
+    fromIntegral result
+ where
+  maxWord32 :: Word64
+  maxWord32 = 0xFFFFFFFF
diff --git a/src/Telescope/Fits/DataArray.hs b/src/Telescope/Fits/DataArray.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Fits/DataArray.hs
@@ -0,0 +1,85 @@
+module Telescope.Fits.DataArray
+  ( DataArray (..)
+  , dataArray
+  , decodeDataArray
+  , encodeDataArray
+  )
+where
+
+import Control.Monad.Catch (MonadCatch)
+import Data.ByteString (ByteString)
+import Data.Fits qualified as Fits
+import Data.Massiv.Array as M hiding (isEmpty, product)
+import System.ByteOrder
+import Telescope.Data.Array
+import Telescope.Data.Axes
+import Telescope.Data.Binary
+import Telescope.Fits.Types
+
+
+-- > {-# LANGUAGE TypeApplications #-}
+-- > import Data.Massiv.Array
+-- > import Data.Fits.Image
+-- > import Data.Fits
+-- >
+-- > decodeExample :: BL.ByteString -> Either String Int
+-- > decodeExample bs = do
+-- >  hdu <- readPrimaryHDU bs
+-- >  arr <- decodeImage @Ix2 $ hdu.dataArray
+-- >  pure $ arr !> 1 ! 2
+
+{- | Decode a 'DataArray' of arbitrary dimensions 'ix' and type 'a'. Consider inspecting the DataArray's (.bitpix) and (.axes) if these are unknown.
+
+>>> decodeDataArray @Ix2 @Float hdu.dataArray
+Array D Seq (Sz (2 :. 3))
+  [ [ 1.0, 2.0, 3.0 ]
+  , [ 4.0, 5.0, 6.0 ]
+  ]
+
+This creates a delayed (D) array, which will postpone evaluation of cells until needed
+-}
+decodeDataArray :: forall ix a m. (MonadThrow m, MonadCatch m) => (Index ix, AxesIndex ix, Prim a, BinaryValue a) => DataArray -> m (Array D ix a)
+decodeDataArray DataArray{axes, rawData} = do
+  decodeArrayOrder BigEndian (toRowMajor axes) rawData
+
+
+{- | Encode an 'Array' to a 'DataArray'
+
+>>> encodeImage array
+DataArray:
+  data: 48 bytes
+  dimensions:
+    format: Int64
+    axes: [3,2]
+-}
+encodeDataArray
+  :: forall r ix a
+   . (Source r a, Stream r Ix1 a, Size r, PutArray ix, Index ix, AxesIndex ix, BinaryValue a, Prim a, IsBitPix a)
+  => Array r ix a
+  -> DataArray
+encodeDataArray arr =
+  let axes = sizeAxes $ size arr
+      bitpix = bitPix @a
+      rawData = encodeArray arr -- O(n)
+   in DataArray{bitpix, axes, rawData}
+
+
+-- | Create a DataArray from raw Fits info
+dataArray :: Fits.Dimensions -> ByteString -> DataArray
+dataArray dim dat =
+  DataArray
+    { bitpix = bitpix dim._bitpix
+    , axes = axes dim._axes
+    , rawData = dat
+    }
+ where
+  bitpix :: Fits.BitPixFormat -> BitPix
+  bitpix Fits.EightBitInt = BPInt8
+  bitpix Fits.SixteenBitInt = BPInt16
+  bitpix Fits.ThirtyTwoBitInt = BPInt32
+  bitpix Fits.SixtyFourBitInt = BPInt64
+  bitpix Fits.ThirtyTwoBitFloat = BPFloat
+  bitpix Fits.SixtyFourBitFloat = BPDouble
+
+  axes :: Fits.Axes -> Axes Column
+  axes = Axes
diff --git a/src/Telescope/Fits/Encoding.hs b/src/Telescope/Fits/Encoding.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Fits/Encoding.hs
@@ -0,0 +1,198 @@
+module Telescope.Fits.Encoding
+  ( -- * Decoding
+    decode
+
+    -- * Encoding
+  , encode
+  , encodePrimaryHDU
+  , encodeImageHDU
+  , encodeExtension
+  , encodeHDU
+  , replaceKeywordLine
+
+    -- * Parser
+  , nextParser
+  , parseFits
+  , parseMainData
+  , HDUError (..)
+  )
+where
+
+import Control.Exception (Exception)
+import Control.Monad.Catch (MonadThrow, throwM)
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
+import Data.Fits qualified as Fits
+import Data.Fits.MegaParser qualified as Fits
+import Data.Fits.Read (FitsError (..))
+import Data.Text (Text)
+import Data.Text.Encoding qualified as TE
+import Effectful
+import Effectful.Error.Static
+import Effectful.State.Static.Local
+import Telescope.Fits.Checksum
+import Telescope.Fits.DataArray (dataArray)
+import Telescope.Fits.Encoding.Render
+import Telescope.Fits.Types
+import Text.Megaparsec qualified as M
+import Text.Megaparsec.State qualified as M
+
+
+{- | Decode a FITS file read as a strict 'ByteString'
+
+>  decode =<< BS.readFile "samples/simple2x3.fits"
+-}
+decode :: forall m. (MonadThrow m) => ByteString -> m Fits
+decode inp = do
+  let res = runPureEff $ runErrorNoCallStack @HDUError $ evalState inp parseFits
+  case res of
+    Left e -> throwM e
+    Right a -> pure a
+
+
+{- | Encode a FITS file to a strict 'ByteString'
+
+> BS.writeFile $ encdoe fits
+-}
+encode :: Fits -> ByteString
+encode f =
+  let primary = encodePrimaryHDU f.primaryHDU
+      exts = fmap encodeExtension f.extensions
+   in mconcat $ primary : exts
+
+
+encodePrimaryHDU :: PrimaryHDU -> ByteString
+encodePrimaryHDU p =
+  encodeHDU (renderPrimaryHeader p.header p.dataArray) p.dataArray.rawData
+
+
+encodeImageHDU :: ImageHDU -> ByteString
+encodeImageHDU p =
+  encodeHDU (renderImageHeader p.header p.dataArray) p.dataArray.rawData
+
+
+encodeExtension :: Extension -> ByteString
+encodeExtension (Image hdu) = encodeImageHDU hdu
+encodeExtension (BinTable _) = error "BinTableHDU rendering not supported"
+
+
+-- | Encode an HDU, properly handling datasum and checksum
+encodeHDU :: (Checksum -> BuilderBlock) -> ByteString -> ByteString
+encodeHDU buildHead rawData =
+  let dsum = checksum rawData
+   in encodeHeader dsum <> renderDataArray rawData
+ where
+  encodeHeader :: Checksum -> ByteString
+  encodeHeader dsum =
+    let h = BS.toStrict $ runRender (buildHead dsum)
+        hsum = checksum h -- calculate the checksum of only the header
+        csum = hsum <> dsum -- 1s complement add to the datasum
+     in replaceChecksum csum h
+
+  replaceChecksum :: Checksum -> ByteString -> ByteString
+  replaceChecksum csum = replaceKeywordLine "CHECKSUM" (String $ encodeChecksum csum) Nothing
+
+
+-- | Fast replace a single keyword in a raw header bytestring
+replaceKeywordLine :: ByteString -> Value -> Maybe Text -> ByteString -> ByteString
+replaceKeywordLine key val mc header =
+  let (start, rest) = BS.breakSubstring key header
+      newKeyLine = BS.toStrict $ runRender $ renderKeywordLine (TE.decodeUtf8 key) val mc
+   in start <> newKeyLine <> BS.drop 80 rest
+
+
+parseFits :: forall es. (State ByteString :> es, Error HDUError :> es) => Eff es Fits
+parseFits = do
+  p <- primary
+  es <- extensions
+  pure $ Fits p es
+ where
+  primary :: Eff es PrimaryHDU
+  primary = do
+    (dm, hd) <- nextParser "Primary Header" $ do
+      dm <- Fits.parsePrimaryKeywords
+      hd <- Fits.parseHeader
+      pure (dm, hd)
+
+    darr <- parseMainData dm
+    pure $ PrimaryHDU hd darr
+
+  extensions :: Eff es [Extension]
+  extensions = do
+    inp <- get @ByteString
+    case inp of
+      "" -> pure []
+      _ -> do
+        e <- extension
+        es <- extensions
+        pure (e : es)
+
+  extension :: Eff es Extension
+  extension = do
+    -- this consumes input!
+    resImg <- tryError @HDUError image
+    resTbl <- tryError @HDUError binTable
+    case (resImg, resTbl) of
+      (Right i, _) -> pure $ Image i
+      (_, Right b) -> pure $ BinTable b
+      (Left (_, FormatError ie), Left (_, FormatError be)) -> throwM $ InvalidHDU [ie, be]
+      (Left _, Left (_, be)) -> throwM be
+
+  image :: Eff es ImageHDU
+  image = do
+    (dm, hd) <- imageHeader
+    darr <- parseMainData dm
+    pure $ ImageHDU hd darr
+
+  imageHeader :: Eff es (Fits.Dimensions, Header)
+  imageHeader = do
+    nextParser "Image Header" $ do
+      dm <- Fits.parseImageKeywords
+      hd <- Fits.parseHeader
+      pure (dm, hd)
+
+  binTable :: Eff es BinTableHDU
+  binTable = do
+    (dm, pcount, hd) <- binTableHeader
+    darr <- parseMainData dm
+    rest <- get
+    let heap = BS.take pcount rest
+    put $ BS.dropWhile (== 0) $ BS.drop pcount rest
+    pure $ BinTableHDU hd pcount heap darr
+
+  binTableHeader :: Eff es (Fits.Dimensions, Int, Header)
+  binTableHeader = do
+    nextParser "BinTable Header" $ do
+      (dm, pcount) <- Fits.parseBinTableKeywords
+      hd <- Fits.parseHeader
+      pure (dm, pcount, hd)
+
+
+parseMainData :: (State ByteString :> es) => Fits.Dimensions -> Eff es DataArray
+parseMainData dm = do
+  rest <- get
+  let len = Fits.dataSize dm
+  let dat = dataArray dm (BS.take len rest)
+  put $ BS.dropWhile (== 0) $ BS.drop len rest
+  pure dat
+
+
+-- | Parse HDUs by running MegaParsec parsers one at a time, tracking how much of the ByteString we've consumed
+nextParser :: (Error HDUError :> es, State ByteString :> es) => String -> Fits.Parser a -> Eff es a
+nextParser src parse = do
+  bs <- get
+  let st1 = M.initialState src bs
+  case M.runParser' parse st1 of
+    (st2, Right a) -> do
+      -- only consumes input if it succeeds
+      put $ BS.drop st2.stateOffset bs
+      pure a
+    (_, Left err) -> throwError $ FormatError $ ParseError err
+
+
+data HDUError
+  = InvalidExtension String
+  | MissingPrimary
+  | FormatError FitsError
+  | InvalidHDU [FitsError]
+  deriving (Show, Exception)
diff --git a/src/Telescope/Fits/Encoding/Render.hs b/src/Telescope/Fits/Encoding/Render.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Fits/Encoding/Render.hs
@@ -0,0 +1,205 @@
+module Telescope.Fits.Encoding.Render where
+
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
+import Data.ByteString.Builder
+import Data.ByteString.Lazy qualified as BL
+import Data.Char (toUpper)
+import Data.String (IsString (..))
+import Data.Text (Text, isPrefixOf, pack, unpack)
+import Data.Text qualified as T
+import Telescope.Fits.Checksum
+import Telescope.Fits.Types
+
+
+renderDataArray :: ByteString -> ByteString
+renderDataArray dat = BS.toStrict $ runRender $ renderData dat
+
+
+renderData :: ByteString -> BuilderBlock
+renderData s = fillBlock zeros $ BuilderBlock (BS.length s) $ byteString s
+
+
+renderImageHeader :: Header -> DataArray -> Checksum -> BuilderBlock
+renderImageHeader h d dsum =
+  fillBlock spaces $
+    mconcat
+      [ renderKeywordLine "XTENSION" (String "IMAGE   ") (Just "Image Extension")
+      , renderDataKeywords d.bitpix d.axes
+      , renderKeywordLine "PCOUNT" (Integer 0) Nothing
+      , renderKeywordLine "GCOUNT" (Integer 1) Nothing
+      , renderDatasum dsum
+      , renderOtherKeywords h
+      , renderEnd
+      ]
+
+
+renderPrimaryHeader :: Header -> DataArray -> Checksum -> BuilderBlock
+renderPrimaryHeader h d dsum =
+  fillBlock spaces $
+    mconcat
+      [ renderKeywordLine "SIMPLE" (Logic T) (Just "Conforms to the FITS standard")
+      , renderDataKeywords d.bitpix d.axes
+      , renderKeywordLine "EXTEND" (Logic T) Nothing
+      , renderDatasum dsum
+      , renderOtherKeywords h
+      , renderEnd
+      ]
+
+
+renderDatasum :: Checksum -> BuilderBlock
+renderDatasum dsum =
+  mconcat
+    [ renderKeywordLine "DATASUM" (checksumValue dsum) Nothing
+    , -- encode the CHECKSUM as zeros, replace later in 'runRenderHDU'
+      renderKeywordLine "CHECKSUM" (String (T.replicate 16 "0")) Nothing
+    ]
+
+
+renderEnd :: BuilderBlock
+renderEnd = pad 80 "END"
+
+
+-- | Render required keywords for a data array
+renderDataKeywords :: BitPix -> Axes Column -> BuilderBlock
+renderDataKeywords bp (Axes as) =
+  mconcat
+    [ bitpix
+    , naxis_
+    , naxes
+    ]
+ where
+  bitpix = renderKeywordLine "BITPIX" (Integer $ bitPixCode bp) (Just $ "(" <> bitPixType bp <> ") array data type")
+  naxis_ = renderKeywordLine "NAXIS" (Integer $ length as) (Just "number of axes in data array")
+  naxes = mconcat $ zipWith @Int naxisN [1 ..] as
+  naxisN n a =
+    let nt = pack (show n)
+     in renderKeywordLine ("NAXIS" <> nt) (Integer a) (Just $ "axis " <> nt <> " length")
+  bitPixType = pack . drop 2 . show
+  bitPixCode :: BitPix -> Int
+  bitPixCode = \case
+    BPInt8 -> 8
+    BPInt16 -> 16
+    BPInt32 -> 32
+    BPInt64 -> 64
+    BPFloat -> -32
+    BPDouble -> -64
+
+
+-- | 'Header' contains all other keywords. Filter out any that match system keywords so they aren't rendered twice
+renderOtherKeywords :: Header -> BuilderBlock
+renderOtherKeywords (Header ks) =
+  mconcat $ map toLine $ filter (not . isSystemKeyword) ks
+ where
+  toLine (Keyword kr) = renderKeywordLine kr._keyword kr._value kr._comment
+  toLine (Comment c) = pad 80 $ string $ "COMMENT " <> unpack c
+  toLine BlankLine = pad 80 ""
+  isSystemKeyword (Keyword kr) =
+    let k = kr._keyword
+     in k == "BITPIX"
+          || k == "EXTEND"
+          || k == "DATASUM"
+          || k == "CHECKSUM"
+          || "NAXIS" `isPrefixOf` k
+  isSystemKeyword _ = False
+
+
+-- | Fill out the header or data block to the nearest 2880 bytes
+fillBlock :: (Int -> BuilderBlock) -> BuilderBlock -> BuilderBlock
+fillBlock fill b =
+  let rm = hduBlockSize - b.length `mod` hduBlockSize
+   in b <> extraSpaces rm
+ where
+  extraSpaces n
+    | n == hduBlockSize = mempty
+    | otherwise = fill n
+
+
+-- Keyword Lines -----------------------------------------------------
+
+renderKeywordLine :: Text -> Value -> Maybe Text -> BuilderBlock
+renderKeywordLine k v mc =
+  let kv = renderKeywordValue k v
+   in pad 80 $ addComment kv mc
+ where
+  addComment kv Nothing = kv
+  addComment kv (Just c) =
+    let mx = 80 - kv.length
+     in kv <> renderComment mx c
+
+
+renderKeywordValue :: Text -> Value -> BuilderBlock
+renderKeywordValue k v =
+  mconcat
+    [ renderKeyword k
+    , string "= "
+    , pad 20 $ renderValue v
+    ]
+
+
+renderKeyword :: Text -> BuilderBlock
+renderKeyword k = pad 8 $ string $ map toUpper $ take 8 $ unpack k
+
+
+renderComment :: Int -> Text -> BuilderBlock
+renderComment mx c = string $ take mx $ " / " <> unpack c
+
+
+renderValue :: Value -> BuilderBlock
+renderValue (Logic T) = justify 20 "T"
+renderValue (Logic F) = justify 20 "F"
+renderValue (Float f) = justify 20 $ string $ map toUpper $ show f
+renderValue (Integer n) = justify 20 $ string $ show n
+renderValue (String s) = string $ "'" <> unpack s <> "'"
+
+
+-- Builder Block ---------------------------------------------------------
+
+-- | A builder that keeps track of its length so we can pad and justify things
+data BuilderBlock = BuilderBlock {length :: Int, builder :: Builder}
+
+
+-- | Smart constructor, don't allow negative lengths
+builderBlock :: Int -> Builder -> BuilderBlock
+builderBlock n = BuilderBlock (max n 0)
+
+
+-- | Execute a BuilderBlock and create a bytestring
+runRender :: BuilderBlock -> BL.ByteString
+runRender bb = toLazyByteString bb.builder
+
+
+instance IsString BuilderBlock where
+  fromString = string
+
+
+instance Semigroup BuilderBlock where
+  BuilderBlock l b <> BuilderBlock l2 b2 = BuilderBlock (l + l2) (b <> b2)
+
+
+instance Monoid BuilderBlock where
+  mempty = BuilderBlock 0 mempty
+
+
+justify :: Int -> BuilderBlock -> BuilderBlock
+justify n b = spaces (n - b.length) <> b
+
+
+pad :: Int -> BuilderBlock -> BuilderBlock
+pad n b = b <> spaces (n - b.length)
+
+
+spaces :: Int -> BuilderBlock
+spaces = padding (charUtf8 ' ')
+
+
+zeros :: Int -> BuilderBlock
+zeros = padding (word8 0)
+
+
+padding :: Builder -> Int -> BuilderBlock
+padding b n = builderBlock n . mconcat . replicate n $ b
+
+
+string :: String -> BuilderBlock
+string s = builderBlock (length s) (stringUtf8 s)
diff --git a/src/Telescope/Fits/Header.hs b/src/Telescope/Fits/Header.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Fits/Header.hs
@@ -0,0 +1,43 @@
+module Telescope.Fits.Header
+  ( Header (..)
+  , Value (..)
+  , keyword
+  , addComment
+
+    -- * Parsing Headers
+  , FromHeader (..)
+  , FromKeyword (..)
+
+    -- * Creating Headers
+  , ToHeader (..)
+  , ToKeyword (..)
+  , parseKeyword
+
+    -- * Keyword Lookup
+  , lookupKeyword
+  , findKeyword
+  , isKeyword
+  , HeaderFor (..)
+
+    -- * Re-exports
+  , LogicalConstant (..)
+  , getKeywords
+  , HeaderRecord (..)
+  , KeywordRecord (..)
+  ) where
+
+import Data.Fits hiding (isKeyword, lookup)
+import Data.Text (Text)
+import Telescope.Fits.Header.Class
+import Telescope.Fits.Header.Keyword (findKeyword, isKeyword, lookupKeyword)
+import Prelude hiding (lookup)
+
+
+-- | Construct a keyword HeaderRecord
+keyword :: Text -> Value -> Maybe Text -> HeaderRecord
+keyword k v mc = Keyword $ KeywordRecord k v mc
+
+
+-- | Set the comment of a KeywordRecrod
+addComment :: Text -> KeywordRecord -> KeywordRecord
+addComment c kr = kr{_comment = Just c}
diff --git a/src/Telescope/Fits/Header/Class.hs b/src/Telescope/Fits/Header/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Fits/Header/Class.hs
@@ -0,0 +1,213 @@
+module Telescope.Fits.Header.Class where
+
+import Data.Fits as Fits hiding (isKeyword)
+import Data.Text (Text, pack)
+import Data.Text qualified as T
+import Effectful
+import GHC.Generics
+import Telescope.Data.Axes (AxisOrder (..))
+import Telescope.Data.KnownText
+import Telescope.Data.Parser
+import Telescope.Data.WCS (CType (..), CUnit (..), WCSAxis (..), toWCSAxisKey)
+import Telescope.Fits.Header.Keyword (lookupKeyword)
+import Text.Casing (fromHumps, toSnake)
+
+
+class ToKeyword a where
+  toKeywordValue :: a -> Value
+
+
+  -- Can ignore the selector name, modify it, etc
+  toKeywordRecord :: Text -> a -> KeywordRecord
+  default toKeywordRecord :: Text -> a -> KeywordRecord
+  toKeywordRecord key a =
+    KeywordRecord key (toKeywordValue a) Nothing
+
+
+instance ToKeyword Int where
+  toKeywordValue = Integer
+instance FromKeyword Int where
+  parseKeywordValue = \case
+    Integer n -> pure n
+    v -> expected "Integer" v
+
+
+instance ToKeyword Float where
+  toKeywordValue = Float
+instance FromKeyword Float where
+  parseKeywordValue = \case
+    Float n -> pure n
+    v -> expected "Float" v
+
+
+instance ToKeyword Text where
+  toKeywordValue = String
+instance FromKeyword Text where
+  parseKeywordValue = \case
+    String n -> pure n
+    v -> expected "String" v
+
+
+instance ToKeyword Bool where
+  toKeywordValue True = Logic T
+  toKeywordValue False = Logic F
+instance FromKeyword Bool where
+  parseKeywordValue = \case
+    Logic c -> pure $ c == T
+    v -> expected "Logic" v
+
+
+instance ToKeyword CUnit where
+  toKeywordValue (CUnit t) = toKeywordValue t
+instance FromKeyword CUnit where
+  parseKeywordValue = \case
+    String t -> pure $ CUnit t
+    v -> expected "CUnit" v
+
+
+instance ToKeyword CType where
+  toKeywordValue (CType t) = toKeywordValue t
+instance FromKeyword CType where
+  parseKeywordValue = \case
+    String t -> pure $ CType t
+    v -> expected "CType" v
+
+
+class FromKeyword a where
+  parseKeywordValue :: (Parser :> es) => Value -> Eff es a
+
+
+class ToHeader a where
+  toHeader :: a -> Header
+  default toHeader :: (Generic a, GToHeader (Rep a)) => a -> Header
+  toHeader = gToHeader . from
+
+
+instance (ToHeader a) => ToHeader (Maybe a) where
+  toHeader Nothing = mempty
+  toHeader (Just a) = toHeader a
+
+
+instance (ToHeader a) => ToHeader [a] where
+  toHeader = mconcat . fmap toHeader
+
+
+instance (AxisOrder ax, KnownText alt) => ToHeader (WCSAxis alt ax) where
+  toHeader axis =
+    mconcat
+      [ axisKey "ctype" axis.ctype
+      , axisKey "cunit" axis.cunit
+      , axisKey "crpix" axis.crpix
+      , axisKey "crval" axis.crval
+      , axisKey "cdelt" axis.cdelt
+      ]
+   where
+    axisKey :: (ToKeyword a) => String -> a -> Header
+    axisKey s a =
+      Header [Keyword $ toKeywordRecord (keyword s) a]
+
+    keyword s = toWCSAxisKey @alt @ax $ cleanKeyword s
+
+
+class FromHeader a where
+  parseHeader :: (Parser :> es) => Header -> Eff es a
+  default parseHeader :: (Generic a, GFromHeader (Rep a), Parser :> es) => Header -> Eff es a
+  parseHeader h = to <$> gParseHeader h
+
+
+instance (AxisOrder ax, KnownText alt) => FromHeader (WCSAxis alt ax) where
+  parseHeader h = do
+    ctype <- parseAxisKey "ctype" h
+    cunit <- parseAxisKey "cunit" h
+    crpix <- parseAxisKey "crpix" h
+    crval <- parseAxisKey "crval" h
+    cdelt <- parseAxisKey "cdelt" h
+    pure $ WCSAxis{ctype, cunit, crpix, crval, cdelt}
+   where
+    parseAxisKey :: (FromKeyword a, Parser :> es) => String -> Header -> Eff es a
+    parseAxisKey k = do
+      parseKeyword (toWCSAxisKey @alt @ax $ cleanKeyword k)
+
+
+parseKeyword :: (FromKeyword a, Parser :> es) => Text -> Header -> Eff es a
+parseKeyword k h =
+  case Fits.lookup k h of
+    Nothing -> parseFail $ "Missing key: " ++ show k
+    Just v -> parseAt (Child k) $ parseKeywordValue v
+
+
+class GToHeader f where
+  gToHeader :: f p -> Header
+
+
+instance (GToHeader f) => GToHeader (M1 D c f) where
+  gToHeader (M1 f) = gToHeader f
+
+
+instance (GToHeader f) => GToHeader (M1 C c f) where
+  gToHeader (M1 f) = gToHeader f
+
+
+instance (GToHeader f, GToHeader g) => GToHeader (f :*: g) where
+  gToHeader (f :*: g) = gToHeader f <> gToHeader g
+
+
+instance {-# OVERLAPPABLE #-} (ToKeyword a, Selector s) => GToHeader (M1 S s (K1 R a)) where
+  gToHeader (M1 (K1 a)) = keywordForField (selName (undefined :: M1 S s f p)) a
+
+
+instance {-# OVERLAPS #-} (ToKeyword a, Selector s) => GToHeader (M1 S s (K1 R (Maybe a))) where
+  gToHeader (M1 (K1 Nothing)) = Header []
+  gToHeader (M1 (K1 (Just a))) = keywordForField (selName (undefined :: M1 S s f p)) a
+
+
+instance {-# OVERLAPS #-} (ToHeader a, Selector s) => GToHeader (M1 S s (K1 R (HeaderFor a))) where
+  gToHeader (M1 (K1 (HeaderFor a))) = toHeader a
+
+
+class GFromHeader f where
+  gParseHeader :: (Parser :> es) => Header -> Eff es (f p)
+
+
+instance (GFromHeader f) => GFromHeader (M1 D c f) where
+  gParseHeader h = M1 <$> gParseHeader h
+
+
+instance (GFromHeader f) => GFromHeader (M1 C c f) where
+  gParseHeader h = M1 <$> gParseHeader h
+
+
+instance (GFromHeader f, GFromHeader g) => GFromHeader (f :*: g) where
+  gParseHeader h = do
+    f <- gParseHeader h
+    g <- gParseHeader h
+    pure $ f :*: g
+
+
+instance {-# OVERLAPPABLE #-} (FromKeyword a, Selector s) => GFromHeader (M1 S s (K1 R a)) where
+  gParseHeader h = do
+    let k = cleanKeyword $ selName (undefined :: M1 S s f p)
+    M1 . K1 <$> parseKeyword k h
+
+
+instance {-# OVERLAPS #-} (FromKeyword a, Selector s) => GFromHeader (M1 S s (K1 R (Maybe a))) where
+  gParseHeader h = do
+    let k = cleanKeyword $ selName (undefined :: M1 S s f p)
+    let mval = lookupKeyword k h :: Maybe Value
+    M1 . K1 <$> case mval of
+      Nothing -> pure Nothing
+      Just v -> do
+        a <- parseAt (Child k) $ parseKeywordValue v
+        pure $ Just a
+
+
+cleanKeyword :: String -> Text
+cleanKeyword = T.toUpper . pack . toSnake . fromHumps
+
+
+newtype HeaderFor a = HeaderFor a
+
+
+keywordForField :: (ToKeyword a) => String -> a -> Header
+keywordForField selector a =
+  Header [Keyword $ toKeywordRecord (cleanKeyword selector) a]
diff --git a/src/Telescope/Fits/Header/Keyword.hs b/src/Telescope/Fits/Header/Keyword.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Fits/Header/Keyword.hs
@@ -0,0 +1,21 @@
+module Telescope.Fits.Header.Keyword where
+
+import Data.Fits as Fits hiding (isKeyword)
+import Data.List qualified as L
+import Data.Text (Text)
+import Data.Text qualified as T
+
+
+-- | Manually look up a keyword from the header
+lookupKeyword :: Text -> Header -> Maybe Value
+lookupKeyword k = findKeyword (isKeyword k)
+
+
+findKeyword :: (KeywordRecord -> Bool) -> Header -> Maybe Value
+findKeyword p h = do
+  kr <- L.find p (getKeywords h)
+  pure kr._value
+
+
+isKeyword :: Text -> KeywordRecord -> Bool
+isKeyword k (KeywordRecord k2 _ _) = T.toLower k == T.toLower k2
diff --git a/src/Telescope/Fits/Types.hs b/src/Telescope/Fits/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Telescope/Fits/Types.hs
@@ -0,0 +1,166 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+
+module Telescope.Fits.Types
+  ( Fits (..)
+  , PrimaryHDU (..)
+  , ImageHDU (..)
+  , BinTableHDU (..)
+  , DataArray (..)
+  , Extension (..)
+  , Axis
+  , Axes (..)
+  , Major (..)
+  , BitPix (..)
+  , bitPixBits
+  , Header (..)
+  , getKeywords
+  , HeaderRecord (..)
+  , KeywordRecord (..)
+  , Value (..)
+  , LogicalConstant (..)
+  , hduBlockSize
+  , emptyDataArray
+  , IsBitPix (..)
+  ) where
+
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
+import Data.Fits (Header (..), HeaderRecord (..), KeywordRecord (..), LogicalConstant (..), Value (..), getKeywords, hduBlockSize)
+import Data.List qualified as L
+import GHC.Int
+import Telescope.Data.Axes
+
+
+data PrimaryHDU = PrimaryHDU
+  { header :: Header
+  , dataArray :: DataArray
+  }
+
+
+instance Show PrimaryHDU where
+  show p = showHDU "PrimaryHDU" p.header p.dataArray
+
+
+data ImageHDU = ImageHDU
+  { header :: Header
+  , dataArray :: DataArray
+  }
+
+
+instance Show ImageHDU where
+  show p = showHDU "ImageHDU" p.header p.dataArray
+
+
+data BinTableHDU = BinTableHDU
+  { header :: Header
+  , pCount :: Int
+  , heap :: ByteString
+  , dataArray :: DataArray
+  }
+
+
+instance Show BinTableHDU where
+  show p = showHDU "BinTableHDU" p.header p.dataArray
+
+
+-- | Raw HDU Data. See 'Telescope.Fits.DataArray'
+data DataArray = DataArray
+  { bitpix :: BitPix
+  , axes :: Axes Column
+  , rawData :: BS.ByteString
+  }
+
+
+instance Show DataArray where
+  show d =
+    L.intercalate
+      "\n"
+      [ "  data: " <> show (BS.length d.rawData) <> " bytes"
+      , "  dimensions: "
+      , "    format: " <> L.drop 2 (show d.bitpix)
+      , "    axes: " <> show d.axes.axes
+      ]
+
+
+showHDU :: String -> Header -> DataArray -> String
+showHDU name h d =
+  L.intercalate
+    "\n"
+    [ name
+    , showHeader h
+    , show d
+    ]
+
+
+showHeader :: Header -> String
+showHeader h =
+  "  Header: " <> show (length $ getKeywords h)
+
+
+emptyDataArray :: DataArray
+emptyDataArray = DataArray BPInt8 (Axes []) ""
+
+
+-- data BinaryTable = BinaryTable
+--   { pCount :: Int
+--   , heap :: ByteString
+--   }
+
+data Extension
+  = Image ImageHDU
+  | BinTable BinTableHDU
+
+
+instance Show Extension where
+  show (Image i) = show i
+  show (BinTable b) = show b
+
+
+data Fits = Fits
+  { primaryHDU :: PrimaryHDU
+  , extensions :: [Extension]
+  }
+
+
+instance Show Fits where
+  show f =
+    show f.primaryHDU
+      <> "\n"
+      <> L.intercalate "\n" (fmap show f.extensions)
+
+
+data BitPix
+  = BPInt8
+  | BPInt16
+  | BPInt32
+  | BPInt64
+  | BPFloat
+  | BPDouble
+  deriving (Show, Eq)
+
+
+bitPixBits :: BitPix -> Int
+bitPixBits BPInt8 = 8
+bitPixBits BPInt16 = 16
+bitPixBits BPInt32 = 32
+bitPixBits BPInt64 = 64
+bitPixBits BPFloat = 32
+bitPixBits BPDouble = 64
+
+
+class IsBitPix a where
+  bitPix :: BitPix
+
+
+instance IsBitPix Int8 where
+  bitPix = BPInt8
+instance IsBitPix Int16 where
+  bitPix = BPInt16
+instance IsBitPix Int32 where
+  bitPix = BPInt32
+instance IsBitPix Int64 where
+  bitPix = BPInt64
+instance IsBitPix Float where
+  bitPix = BPFloat
+instance IsBitPix Double where
+  bitPix = BPDouble
diff --git a/src/checksum.c b/src/checksum.c
new file mode 100644
--- /dev/null
+++ b/src/checksum.c
@@ -0,0 +1,98 @@
+#include "checksum.h"
+#include <stdio.h>
+
+// From FITS standard 4.0
+
+int sum(int* array, int size) {
+    int total = 0;
+    for (int i = 0; i < size; i++) {
+      total += array[i];
+    }
+    return total;
+}
+
+// J.5. Example C code for accumulating the checksum
+// --------------------------------------------------
+
+unsigned int checksum (
+  unsigned char *buf,
+  int length)
+{
+
+  unsigned int sum32 = 0;
+  unsigned int hi, lo, hicarry, locarry, i;
+
+  // Accumulate the sum of the high-order 16 bits and the */
+  // low-order 16 bits of each 32-bit word, separately. */
+  // The first byte in each pair is the most significant. */
+  // This algorithm works on both big and little endian machines.
+  hi = (sum32 >> 16);
+  lo = sum32 & 0xFFFF;
+  for (i=0; i < length; i+=4) {
+    hi += ((buf[i] << 8) + buf[i+1]);
+    lo += ((buf[i+2] << 8) + buf[i+3]);
+  }
+
+  // fold carry bits from each 16 bit sum into the other sum
+  hicarry = hi >> 16;
+  locarry = lo >> 16;
+
+  while (hicarry || locarry) {
+    hi = (hi & 0xFFFF) + locarry;
+    lo = (lo & 0xFFFF) + hicarry;
+    hicarry = hi >> 16;
+    locarry = lo >> 16;
+  }
+
+  // Concatenate the high and low parts to form the full 32-bit checksum
+  return (hi << 16) + lo;
+}
+
+
+
+// J.6. Example C code for ASCII encoding
+// --------------------------------------------------
+
+unsigned int exclude[13] = {0x3a, 0x3b, 0x3c, 0x3d, 0x3e, 0x3f, 0x40, 0x5b, 0x5c, 0x5d, 0x5e, 0x5f, 0x60 };
+
+int offset = 0x30; /* ASCII 0 (zero) */
+unsigned long mask[4] = { 0xff000000, 0xff0000, 0xff00, 0xff };
+
+void char_encode (
+    unsigned int value, // 1's complement of the checksum value to be encoded
+    char *ascii)        // Output 16-character encoded string
+{
+  int byte, quotient, remainder, ch[4], check, i, j, k; char asc[32];
+
+  for (i=0; i < 4; i++) {
+    /* each byte becomes four */
+    byte = (value & mask[i]) >> ((3 - i) * 8);
+    quotient = byte / 4 + offset;
+    remainder = byte % 4;
+    for (j=0; j < 4; j++)
+      ch[j] = quotient;
+
+    ch[0] += remainder;
+
+    // avoid ASCII punctuation
+    for (check=1; check;)
+      for (check=0, k=0; k < 13; k++)
+        for (j=0; j < 4; j+=2)
+          if (ch[j]==exclude[k] || ch[j+1]==exclude[k]) {
+            ch[j]++;
+            ch[j+1]--;
+            check++;
+          }
+
+    // assign the bytes
+    for (j=0; j < 4; j++)
+      asc[4*j+i] = ch[j];
+  }
+
+  // Permute the bytes for FITS
+  for (i=0; i < 16; i++)
+    ascii[i] = asc[(i+15)%16];
+
+  // terminate the string
+  ascii[16] = 0;
+}
diff --git a/src/checksum.h b/src/checksum.h
new file mode 100644
--- /dev/null
+++ b/src/checksum.h
@@ -0,0 +1,9 @@
+#ifndef CHECKSUM_H
+#define CHECKSUM_H
+
+unsigned int checksum ( unsigned char *buf, int length);
+
+void char_encode ( unsigned int value, char *ascii);
+
+#endif
+
diff --git a/telescope.cabal b/telescope.cabal
new file mode 100644
--- /dev/null
+++ b/telescope.cabal
@@ -0,0 +1,148 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.37.0.
+--
+-- see: https://github.com/sol/hpack
+
+name:               telescope
+version:            0.2.0
+synopsis:           Astronomical Observations (FITS, ASDF, WCS, etc)
+description:        Work with astronomical observations from modern telescopes
+license:            BSD3
+license-file:       LICENSE
+author:             Sean Hess
+maintainer:         Sean Hess <shess@nso.edu>
+copyright:          (c) 2024 Sean Hess
+category:           Science, Astronomy
+homepage:           https://github.com/dkistdc/telescope.hs
+build-type:         Simple
+extra-source-files:
+    README.md
+    src/checksum.c
+    src/checksum.h
+
+library
+    exposed-modules:
+        Telescope.Asdf
+        Telescope.Asdf.Class
+        Telescope.Asdf.Core
+        Telescope.Asdf.Encoding
+        Telescope.Asdf.Encoding.File
+        Telescope.Asdf.Encoding.Stream
+        Telescope.Asdf.Error
+        Telescope.Asdf.GWCS
+        Telescope.Asdf.NDArray
+        Telescope.Asdf.NDArray.Types
+        Telescope.Asdf.Node
+        Telescope.Asdf.Reference
+        Telescope.Data.Array
+        Telescope.Data.Axes
+        Telescope.Data.Binary
+        Telescope.Data.KnownText
+        Telescope.Data.Parser
+        Telescope.Data.WCS
+        Telescope.Fits
+        Telescope.Fits.Checksum
+        Telescope.Fits.DataArray
+        Telescope.Fits.Encoding
+        Telescope.Fits.Encoding.Render
+        Telescope.Fits.Header
+        Telescope.Fits.Header.Class
+        Telescope.Fits.Header.Keyword
+        Telescope.Fits.Types
+    other-modules:
+        Paths_telescope
+    build-depends:
+        base >=4.7 && <5,
+        binary >=0.8.9 && <0.9,
+        byte-order >=0.1.3 && <0.2,
+        bytestring >=0.11 && <0.13,
+        casing >=0.1.4 && <0.2,
+        conduit ==1.3.*,
+        effectful >=2.3 && <3,
+        exceptions ==0.10.*,
+        fits-parse >=0.4.2 && <0.5,
+        libyaml >=0.1.4 && <0.2,
+        massiv ==1.0.*,
+        megaparsec ==9.6.*,
+        resourcet-effectful >=1.0.1 && <1.1,
+        scientific ==0.3.*,
+        text >=2.0 && <3,
+        time >=1.12 && <2
+    hs-source-dirs:
+        src
+    default-extensions:
+        DataKinds
+        DefaultSignatures
+        DeriveAnyClass
+        DerivingStrategies
+        DuplicateRecordFields
+        LambdaCase
+        NoFieldSelectors
+        OverloadedRecordDot
+        OverloadedStrings
+        QuasiQuotes
+        StrictData
+        TypeApplications
+        TypeFamilies
+    ghc-options: -Wall -fdefer-typed-holes
+    c-sources:
+        src/checksum.c
+    default-language: GHC2021
+
+test-suite spec
+    type: exitcode-stdio-1.0
+    main-is: Spec.hs
+    other-modules:
+        Test.ArraySpec
+        Test.Asdf.ClassSpec
+        Test.Asdf.DecodeSpec
+        Test.Asdf.EncodeSpec
+        Test.Asdf.FileSpec
+        Test.Asdf.GWCSSpec
+        Test.Asdf.NDArraySpec
+        Test.BinarySpec
+        Test.Fits.ChecksumSpec
+        Test.Fits.ClassSpec
+        Test.Fits.EncodingSpec
+        Paths_telescope
+    hs-source-dirs:
+        test/
+    default-extensions:
+        DataKinds
+        DefaultSignatures
+        DeriveAnyClass
+        DerivingStrategies
+        DuplicateRecordFields
+        LambdaCase
+        NoFieldSelectors
+        OverloadedRecordDot
+        OverloadedStrings
+        QuasiQuotes
+        StrictData
+        TypeApplications
+        TypeFamilies
+    ghc-options: -Wall -fdefer-typed-holes -threaded -rtsopts -with-rtsopts=-N -F -pgmF=skeletest-preprocessor
+    build-tool-depends:
+        skeletest:skeletest-preprocessor
+    build-depends:
+        base >=4.7 && <5,
+        binary,
+        byte-order >=0.1.3 && <0.2,
+        bytestring >=0.11 && <0.13,
+        casing >=0.1.4 && <0.2,
+        conduit ==1.3.*,
+        containers,
+        effectful >=2.3 && <3,
+        exceptions ==0.10.*,
+        fits-parse >=0.4.2 && <0.5,
+        libyaml >=0.1.4 && <0.2,
+        massiv ==1.0.*,
+        megaparsec ==9.6.*,
+        resourcet-effectful >=1.0.1 && <1.1,
+        scientific ==0.3.*,
+        skeletest,
+        telescope,
+        text >=2.0 && <3,
+        time >=1.12 && <2
+    default-language: GHC2021
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,3 @@
+import Skeletest.Main
+
+
diff --git a/test/Test/ArraySpec.hs b/test/Test/ArraySpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/ArraySpec.hs
@@ -0,0 +1,119 @@
+{-# LANGUAGE OverloadedLists #-}
+
+module Test.ArraySpec where
+
+import Data.ByteString qualified as BS
+import Data.Massiv.Array as M
+import Data.Word (Word8)
+import GHC.Int
+import Skeletest
+import System.ByteOrder
+import Telescope.Data.Array
+import Telescope.Data.Axes
+import Telescope.Fits.DataArray
+
+
+spec :: Spec
+spec = do
+  describe "indices" testIndices
+  describe "decode" $ do
+    -- describe "vector" testDecode
+    describe "array" testDecodeArray
+    describe "image" testDecodeImage
+
+  describe "encode" $ do
+    describe "array/image" testEncode
+
+
+testIndices :: Spec
+testIndices = do
+  describe "axesIndex" $ do
+    it "Ix1" $ do
+      ix <- axesIndex $ toRowMajor $ Axes [10]
+      ix `shouldBe` Ix1 10
+
+    it "Ix2 in reverse order" $ do
+      ix <- axesIndex $ toRowMajor $ Axes [3, 2]
+      ix `shouldBe` 2 :. 3
+
+    it "Ix3 in reverse order" $ do
+      ix <- axesIndex $ toRowMajor $ Axes [3, 2, 1]
+      ix `shouldBe` 1 :> 2 :. 3
+
+  describe "indexAxes" $ do
+    -- indexAxes produces row major
+    it "Ix1" $ do
+      indexAxes @Ix1 2 `shouldBe` Axes [2]
+
+    it "Ix2 Row Major" $ do
+      indexAxes (2 :. 3) `shouldBe` Axes [2, 3]
+
+    it "Ix3 Row Major" $ do
+      indexAxes (1 :> 2 :. 3) `shouldBe` Axes [1, 2, 3]
+
+    it "Ix3 Column Major" $ do
+      sizeAxes (Sz (1 :> 2 :. 3)) `shouldBe` Axes [3, 2, 1]
+
+
+-- generate a series of Word8
+genInput :: Word8 -> BS.ByteString
+genInput start = BS.pack [start .. start + 100]
+
+
+testDecodeArray :: Spec
+testDecodeArray = do
+  let input = genInput 0
+
+  it "should parse int8 vector" $ do
+    let v = decodeVector @Int8 Par BigEndian input
+    computeAs P (M.take 6 v) `shouldBe` [0, 1, 2, 3, 4, 5]
+
+  it "should decode Ix1 from vector" $ do
+    let v = decodeVector @Int8 Par BigEndian input
+    a <- fromVector @Ix1 (Axes [3]) $ M.take 3 v
+    computeAs P a `shouldBe` [0, 1, 2]
+
+  it "should decode Ix2" $ do
+    a <- decodeArray @Ix2 @Int8 [2, 3] $ BS.take 6 input
+    computeAs P a `shouldBe` [[0, 1, 2], [3, 4, 5]]
+
+  it "should decode Ix3" $ do
+    a <- decodeArray @Ix3 @Int8 [2, 2, 2] $ BS.take 8 input
+    computeAs P a `shouldBe` [[[0, 1], [2, 3]], [[4, 5], [6, 7]]]
+
+
+testDecodeImage :: Spec
+testDecodeImage = do
+  let input = genInput 0
+  it "should decode image" $ do
+    a <- decodeArray @Ix2 @Int8 [2, 3] $ BS.take 6 input
+    computeAs P a `shouldBe` [[0, 1, 2], [3, 4, 5]]
+
+
+testEncode :: Spec
+testEncode = do
+  let array = delay @Ix2 @P $ M.fromLists' Seq [[1, 2, 3], [4, 5, 6]] :: Array D Ix2 Int8
+
+  it "should encode to 6 items" $ do
+    BS.length (encodeArray array) `shouldBe` 6
+
+  it "int8 should round-trip to original array" $ do
+    let enc = encodeArray array :: BS.ByteString
+    arr <- decodeArray @Ix2 @Int8 [2, 3] enc
+    arr `shouldBe` array
+
+  let arrayFloat = delay @Ix2 @P $ M.fromLists' Seq [[1, 2, 3], [4, 5, 6]] :: Array D Ix2 Float
+  it "float should round-trip to original array" $ do
+    let enc = encodeArray arrayFloat :: BS.ByteString
+    arr <- decodeArray [2, 3] enc
+    arr `shouldBe` arrayFloat
+
+  let arrayInt = delay @Ix2 @P $ M.fromLists' Seq [[1, 2, 3], [4, 5, 6]] :: Array D Ix2 Int
+  it "int should round-trip to original array" $ do
+    let enc = encodeArray arrayInt :: BS.ByteString
+    arr <- decodeArray [2, 3] enc
+    arr `shouldBe` arrayInt
+
+  it "should encode naxes in correct order" $ do
+    size array `shouldBe` Sz (2 :. 3)
+    sizeAxes (size array) `shouldBe` Axes [3, 2]
diff --git a/test/Test/Asdf/ClassSpec.hs b/test/Test/Asdf/ClassSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Asdf/ClassSpec.hs
@@ -0,0 +1,206 @@
+module Test.Asdf.ClassSpec where
+
+import Conduit
+import Data.ByteString (ByteString)
+import Data.Massiv.Array (Array, Comp (..), D, Ix1, P)
+import Data.Massiv.Array qualified as M
+import Data.Text (Text)
+import Effectful.Resource
+import GHC.Generics (Generic, from)
+import GHC.Int (Int32, Int64)
+import Skeletest
+import System.ByteOrder
+import Telescope.Asdf.Class
+import Telescope.Asdf.Encoding
+import Telescope.Asdf.Encoding.File
+import Telescope.Asdf.Error
+import Telescope.Asdf.NDArray
+import Telescope.Asdf.Node
+import Telescope.Data.Axes
+import Telescope.Data.Parser
+import Test.Asdf.DecodeSpec (ExampleTreeFix (..), parseIO)
+import Text.Libyaml qualified as Yaml
+
+
+spec :: Spec
+spec = do
+  describe "FromAsdf" fromAsdfSpec
+  describe "ToAsdf" toAsdfSpec
+  describe "GObject" gObjectSpec
+
+
+fromAsdfSpec :: Spec
+fromAsdfSpec = do
+  it "parses object" $ do
+    let (tree :: Object) =
+          [ ("foo", fromValue $ Integer 42)
+          , ("name", fromValue $ String "Monty")
+          , ("sequence", fromValue $ Array $ fmap (fromValue . Integer) [0 .. 99])
+          , ("random", fromValue $ NDArray $ NDArrayData "" BigEndian Float64 (axesRowMajor [0]))
+          ]
+    ex <- parseIO $ parseValue @Example (Object tree)
+    ex.foo `shouldBe` 42
+    ex.name `shouldBe` "Monty"
+    ex.sequence `shouldBe` [0 .. 99]
+
+  it "parses sequence from example.asdf as an NDArray" $ do
+    ExampleTreeFix (Tree tree) <- getFixture
+    (Sequence s) <- parseIO $ parseValue @Sequence (Object tree)
+    s `shouldBe` M.delay (M.fromLists' @P Seq [0 .. 99])
+
+  it "resolves anchors" $ do
+    let ex = AnchorExample "world" "asdf"
+    out <- runAsdfM $ encode ex
+    ex2 <- runAsdfM $ decode @AnchorExample out
+    ex2.message `shouldBe` "world"
+    ex2.alias `shouldBe` "world"
+
+
+toAsdfSpec :: Spec
+toAsdfSpec = do
+  it "should serialize Example" $ do
+    let ex = Example{foo = 40, name = "Marty", sequence = [], powers = Nothing, random = M.empty}
+    let Node s anc val = toNode ex
+    s `shouldBe` schema ex
+    anc `shouldBe` Just "example"
+    o <- expectObject val
+    lookup "foo" o `shouldBe` Just (Node mempty Nothing (Integer 40))
+    lookup "name" o `shouldBe` Just (Node mempty Nothing (String "Marty"))
+
+  it "should serialize Example sequence as list" $ do
+    let val = toValue $ Example{foo = 40, name = "Marty", sequence = [0 .. 99], powers = Nothing, random = M.empty}
+    o <- expectObject val
+    ns <- expectArray $ lookup "sequence" o
+    ns `shouldBe` fmap (fromValue . Integer) [0 .. 99]
+
+  it "should serialize list to Array" $ do
+    let nums = [0 .. 99] :: [Int]
+    toValue nums `shouldBe` Array (fmap (Node mempty Nothing . Integer) [0 .. 99])
+
+  it "should forward schema to maybes" $ do
+    schema @(Maybe Example) Nothing `shouldBe` mempty
+    schema @(Maybe Example) (Just undefined) `shouldBe` schema @Example undefined
+
+
+
+-- it "should produce similar example.asdf" $ do
+--   ExampleFileFix inp _ <- getFixture
+--   e <- decodeM @Example inp
+--   -- o <- encodeM e
+--   -- BS.writeFile "dump/test.asdf" o
+--   -- print e
+--   fail ":NOPE"
+
+gObjectSpec :: Spec
+gObjectSpec = do
+  it "should gen object" $ do
+    gToObject (from (TinyGen "world")) `shouldBe` [("hello", fromValue (String "world"))]
+
+  it "should gen tiny type" $ do
+    toValue (TinyGen "world") `shouldBe` Object [("hello", fromValue (String "world"))]
+
+  it "should gen maybe type" $ do
+    toValue (MaybeGen (Just "world")) `shouldBe` Object [("hello", fromValue (String "world"))]
+    toValue (MaybeGen Nothing) `shouldBe` Object [("hello", fromValue Null)]
+
+  it "should allow maybes" $ do
+    let val = Object [("hello", fromValue (String "world"))]
+    m1 <- parseIO (parseValue val)
+    m1 `shouldBe` MaybeGen (Just "world")
+
+    m2 <- parseIO (parseValue $ Object [])
+    m2 `shouldBe` MaybeGen Nothing
+
+
+-- newtype ExampleAsdfFix = ExampleAsdfFix Asdf
+-- instance Fixture ExampleAsdfFix where
+--   fixtureAction = do
+--     ExampleFileFix _ f <- getFixture
+--     a <- runAsdfM $ fromAsdfFile f.tree f.blocks
+--     pure $ noCleanup $ ExampleAsdfFix a
+
+dumpEvents :: ByteString -> IO ()
+dumpEvents inp = do
+  runAsdfM $ do
+    a <- splitAsdfFile inp
+    runResource $ runConduit $ Yaml.decode a.tree.bytes .| takeC 100 .| mapM_C (liftIO . print)
+
+
+data TinyGen = TinyGen
+  { hello :: Text
+  }
+  deriving (Generic, FromAsdf, ToAsdf)
+
+
+data MaybeGen = MaybeGen
+  { hello :: Maybe Text
+  }
+  deriving (Generic, FromAsdf, ToAsdf, Eq)
+
+
+data Example = Example
+  { foo :: Int32
+  , name :: Text
+  , powers :: Maybe Powers
+  , sequence :: [Int64]
+  , random :: Array D Ix1 Double
+  }
+  deriving (Generic, Show)
+instance ToAsdf Example where
+  schema _ = "example/woot-1.0"
+  anchor _ = Just "example"
+instance FromAsdf Example where
+  parseValue = \case
+    Object o -> do
+      foo <- o .: "foo"
+      name <- o .: "name"
+      sq <- o .: "sequence" >>= parseSequence
+      powers <- o .:? "powers"
+      random <- o .: "random"
+      pure $ Example{foo, name, sequence = sq, powers, random}
+    val -> expected "Example" val
+   where
+    parseSequence = \case
+      Array ns -> mapM parseNode ns
+      NDArray nd -> fromNDArray nd
+      val -> expected "Array or NDArray" val
+
+
+data Powers = Powers
+  {squares :: Array D Ix1 Int64}
+  deriving (Generic, Show, ToAsdf, FromAsdf)
+
+
+data Sequence = Sequence (Array D Ix1 Int64)
+  deriving (Eq)
+instance FromAsdf Sequence where
+  parseValue = \case
+    Object o -> do
+      sql <- o .: "sequence"
+      pure $ Sequence sql
+    node -> expected "Example Sequence" node
+
+
+data AnchorExample = AnchorExample
+  { message :: Text
+  , alias :: Text
+  }
+  deriving (Generic, FromAsdf)
+instance ToAsdf AnchorExample where
+  toValue ae =
+    Object
+      [ ("message", Node mempty (Just "message") $ String ae.message)
+      , ("alias", toNode $ Alias "message")
+      ]
+
+
+expectArray :: Maybe Node -> IO [Node]
+expectArray = \case
+  Just (Node _ _ (Array ns)) -> pure ns
+  n -> fail $ "Expected Array, but got: " ++ show n
+
+
+expectObject :: Value -> IO Object
+expectObject = \case
+  Object o -> pure o
+  n -> fail $ "Expected Object, but got: " ++ show n
diff --git a/test/Test/Asdf/DecodeSpec.hs b/test/Test/Asdf/DecodeSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Asdf/DecodeSpec.hs
@@ -0,0 +1,270 @@
+module Test.Asdf.DecodeSpec where
+
+import Control.Monad.Catch (throwM)
+import Data.ByteString qualified as BS
+import Data.List (find)
+import Data.Massiv.Array (Array, D, Ix1)
+import Data.Massiv.Array qualified as M
+import Data.Text (Text, unpack)
+import Effectful
+import Effectful.Error.Static
+import GHC.Generics (Generic)
+import GHC.Int (Int64)
+import Skeletest
+import Skeletest.Predicate qualified as P
+import Telescope.Asdf.Class
+import Telescope.Asdf.Core
+import Telescope.Asdf.Encoding
+import Telescope.Asdf.Encoding.File
+import Telescope.Asdf.Error
+import Telescope.Asdf.Node
+import Telescope.Asdf.Reference
+import Telescope.Data.Parser
+import Test.Asdf.FileSpec (ExampleFileFix (..))
+
+
+spec :: Spec
+spec = do
+  describe "basic" basicSpec
+  describe "example" exampleSpec
+  describe "dkist" dkistSpec
+  describe "references" referenceSpec
+  describe "anchors" anchorSpec
+
+
+basicSpec :: Spec
+basicSpec = do
+  describe "basic" $ do
+    it "should parse asdf" $ do
+      ExampleTreeFix tree <- getFixture
+      a :: Asdf <- runAsdfM $ decodeFromTree tree
+      a.library.name `shouldBe` "asdf"
+      length a.history.extensions `shouldBe` 1
+
+    it "should parse tree" $ do
+      ExampleTreeFix (Tree tree) <- getFixture
+      lookup "foo" tree `shouldBe` Just (Node mempty Nothing (Integer 42))
+      lookup "name" tree `shouldBe` Just (Node mempty Nothing (String "Monty"))
+
+
+exampleSpec :: Spec
+exampleSpec = do
+  it "should parse example.asdf" $ do
+    inp <- BS.readFile "samples/example.asdf"
+    e <- decodeM @Example inp
+    e.name `shouldBe` "Monty"
+    e.foo `shouldBe` 42
+    e.items `shouldBe` ["one", "two", "three", "four", "five"]
+
+
+data Example = Example
+  { foo :: Int
+  , name :: Text
+  , items :: [Text]
+  }
+  deriving (Generic, FromAsdf, ToAsdf)
+
+
+anchorSpec :: Spec
+anchorSpec = do
+  it "should create anchors" $ do
+    let Encoded out = encodeTree "{hello: &hello world}"
+    f <- runAsdfM $ splitAsdfFile out
+    (_, ancs) <- runAsdfM $ streamAsdfFile f.tree f.blocks
+    ancs `shouldBe` Anchors [("hello", String "world")]
+
+  it "should throw missing anchors" $ do
+    f <- runAsdfM $ do
+      let tree = encodeTree "{message: *somealias}"
+      pure $ AsdfFile tree mempty ""
+    runAsdfM (streamAsdfFile f.tree f.blocks) `shouldSatisfy` P.throws @AsdfError P.anything
+
+  it "should throw if alias before anchor" $ do
+    let Encoded out = encodeTree "{message: *hello, hello: &hello world}"
+    decodeM @Tree out `shouldSatisfy` P.throws @AsdfError P.anything
+
+  it "should succeed if anchor before alias" $ do
+    let Encoded out = encodeTree "{hello: &hello world, message: *hello}"
+    Tree tree <- decodeM @Tree out
+    lookup "message" tree `shouldBe` Just "world"
+
+  it "should decode anchors roundtrip" $ do
+    let root = [("hello", Node mempty (Just "hello") (String "world")), ("message", toNode $ Alias "hello")] :: Object
+    out <- runAsdfM $ encode (Object root)
+    Tree tree <- decodeM @Tree out
+    lookup "message" tree `shouldBe` Just "world"
+
+
+referenceSpec :: Spec
+referenceSpec = do
+  it "should parse pointers" $ do
+    jsonPointer "/users/1/name" `shouldBe` JSONPointer (Path [Child "users", Index 1, Child "name"])
+    jsonPointer "" `shouldBe` JSONPointer (Path [])
+    jsonPointer "#" `shouldBe` JSONPointer (Path [])
+    jsonPointer "/" `shouldBe` JSONPointer (Path [])
+    jsonPointer "users" `shouldBe` JSONPointer (Path [Child "users"])
+    jsonPointer "/users" `shouldBe` JSONPointer (Path [Child "users"])
+    jsonPointer "#users" `shouldBe` JSONPointer (Path [Child "users"])
+
+  it "should parse an internal pointer as a reference" $ do
+    jsonReference "#/users/1/name" `shouldBe` JSONReference mempty (jsonPointer "#/users/1/name")
+
+  it "should parse an external reference" $ do
+    let url = "https://woot.com/asdf"
+    let point = "#/users/1/name"
+    jsonReference (url <> point) `shouldBe` JSONReference url (jsonPointer point)
+
+  it "should show pointers" $ do
+    let point = JSONPointer (Path [Child "users", Index 0, Child "name"])
+    show point `shouldBe` "#/users/0/name"
+
+  it "should show references" $ do
+    let point = JSONPointer (Path [Child "users", Index 0, Child "name"])
+    let uri = "https://example.com/document.asdf/"
+    show (JSONReference uri point) `shouldBe` "https://example.com/document.asdf/#/users/0/name"
+
+  it "should locate pointer" $ do
+    RefTreeFix tree <- getFixture
+    n0 <- parseIO $ findPointer (jsonPointer "#/users/0/name") tree
+    n0 `shouldBe` "Monty"
+
+    n1 <- parseIO $ findPointer (jsonPointer "/users/1/name") tree
+    n1 `shouldBe` "Harold"
+
+
+-- I don't think we should automatically resolve any internal references. Assume all references are external
+-- it "parses Internal Ref to CurrentUsername with tree" $ do
+--   RefTreeFix (Tree tree) <- getFixture
+--   cu <- runParse $ runAsdfParser (Tree tree) $ parseValue @CurrentUsername (InternalRef $ pointer "#/users/2/name")
+--   cu `shouldBe` CurrentUsername "Sandra"
+--
+-- it "parses Internal Ref to RefResolved with tree" $ do
+--   RefTreeFix (Tree tree) <- getFixture
+--   r <- runParse $ runAsdfParser (Tree tree) $ parseValue @RefResolved (Object tree)
+--   length r.users `shouldBe` 3
+--   r.currentUsername `shouldBe` CurrentUsername "Harold"
+--
+-- it "should parse internal references from sample file" $ do
+--   inp <- BS.readFile "./samples/reference.asdf"
+--   r <- decodeM @RefResolved inp
+--   length r.users `shouldBe` 3
+--   fmap (.name) r.users `shouldBe` ["Monty", "Harold", "Sandra"]
+--   r.currentUsername `shouldBe` CurrentUsername "Harold"
+
+-- data RefResolved = RefResolved
+--   { currentUsername :: CurrentUsername
+--   , users :: [RefUser]
+--   }
+--   deriving (Generic, FromAsdf, Show)
+--
+--
+-- data RefUser = RefUser
+--   { name :: Text
+--   }
+--   deriving (Generic, FromAsdf, Show)
+
+-- newtype CurrentUsername = CurrentUsername Text
+--   deriving (Show, Eq)
+-- instance FromAsdf CurrentUsername where
+--   parseValue = \case
+--     String s -> pure $ CurrentUsername s
+--     -- TODO: this should be automagic
+--     InternalRef p -> parsePointer p
+--     val -> expected "UsernameRef" val
+-- instance ToAsdf CurrentUsername where
+--   toValue (CurrentUsername _) = InternalRef $ pointer "/users/2/name"
+
+dkistSpec :: Spec
+dkistSpec = do
+  it "should parse dkist asdf" $ do
+    inp <- BS.readFile "samples/dkist.asdf"
+    d <- decodeM @DKISTAsdf inp
+    d.dataset.unit `shouldBe` Count
+    d.dataset.meta.inventory.datasetId `shouldBe` "AVORO"
+
+    let us = d.dataset.meta.headers.bunit
+    take 3 us `shouldBe` ["ct", "ct", "ct"]
+
+    take 3 (M.toLists d.dataset.meta.headers.naxis2) `shouldBe` [998, 998, 998]
+
+
+data DKISTAsdf = DKISTAsdf
+  { dataset :: Dataset
+  }
+  deriving (Generic, FromAsdf)
+
+
+data Dataset = Dataset
+  { unit :: Unit
+  , meta :: Meta
+  }
+  deriving (Generic, FromAsdf)
+
+
+data Meta = Meta
+  { headers :: MetaHeaders
+  , inventory :: MetaInventory
+  }
+  deriving (Generic, FromAsdf)
+
+
+data MetaInventory = MetaInventory
+  { bucket :: Text
+  , datasetId :: Text
+  }
+  deriving (Generic, FromAsdf)
+
+
+-- can we make this work with a generic?
+data MetaHeaders = MetaHeaders
+  { naxis :: Array D Ix1 Int64
+  , naxis2 :: Array D Ix1 Int64
+  , bitpix :: [Int64]
+  , bunit :: [Text]
+  }
+
+
+instance FromAsdf MetaHeaders where
+  parseValue = \case
+    Object o -> do
+      ns <- o .: "columns"
+      naxis <- parseColumn "NAXIS" ns
+      naxis2 <- parseColumn "NAXIS2" ns
+      bitpix <- parseColumn "BITPIX" ns
+      bunit <- parseColumn "BUNIT" ns
+      pure MetaHeaders{naxis, naxis2, bitpix, bunit}
+    val -> expected "Columns" val
+   where
+    parseColumn :: forall a es. (FromAsdf a, Parser :> es) => Text -> [Node] -> Eff es a
+    parseColumn name ns = do
+      case find (isColumnName name) ns of
+        Just (Node _ _ (Object o)) ->
+          o .: "data"
+        _ -> parseFail $ "Column " ++ unpack name ++ " not found"
+
+    isColumnName n = \case
+      Node _ _ (Object o) -> do
+        lookup "name" o == Just (Node mempty Nothing (String n))
+      _ -> False
+
+
+newtype ExampleTreeFix = ExampleTreeFix Tree
+instance Fixture ExampleTreeFix where
+  fixtureAction = do
+    ExampleFileFix _ f <- getFixture
+    tree <- runAsdfM $ parseAsdfTree f.tree f.blocks
+    pure $ noCleanup $ ExampleTreeFix tree
+
+
+newtype RefTreeFix = RefTreeFix Tree
+instance Fixture RefTreeFix where
+  fixtureAction = do
+    let user n = toNode $ Object [("name", toNode (String n))]
+    let users = toNode $ Array [user "Monty", user "Harold", user "Sandra"]
+    let curr = toNode $ Reference $ JSONReference mempty (jsonPointer "#/users/1/name")
+    let tree = Tree [("users", users), ("currentUsername", toNode curr)]
+    pure $ noCleanup $ RefTreeFix tree
+
+
+parseIO :: Eff '[Parser, Error ParseError, IOE] a -> IO a
+parseIO p = runEff $ runErrorNoCallStackWith @ParseError throwM $ runParser p
diff --git a/test/Test/Asdf/EncodeSpec.hs b/test/Test/Asdf/EncodeSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Asdf/EncodeSpec.hs
@@ -0,0 +1,285 @@
+module Test.Asdf.EncodeSpec where
+
+import Control.Monad (forM_)
+import Data.ByteString qualified as BS
+import Data.ByteString.Char8 qualified as BC
+import Data.Massiv.Array (Array, Comp (Seq), D, Ix2, P)
+import Data.Massiv.Array qualified as M
+import Data.Text (Text)
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as T
+import GHC.Generics (Generic)
+import GHC.Int (Int16, Int64)
+import Skeletest
+import Skeletest.Predicate qualified as P
+import Telescope.Asdf.Class
+import Telescope.Asdf.Core
+import Telescope.Asdf.Encoding
+import Telescope.Asdf.Encoding.File
+import Telescope.Asdf.Error
+import Telescope.Asdf.NDArray
+import Telescope.Asdf.Node
+import Telescope.Data.Parser (expected)
+import Test.Asdf.ClassSpec (expectObject)
+
+
+spec :: Spec
+spec = do
+  describe "basic" basicSpec
+  describe "document" documentSpec
+  describe "blocks" blocksSpec
+  describe "roundtrip" roundSpec
+  describe "stream" streamSpec
+  describe "external verification" externalSpec
+  describe "references" referenceSpec
+  describe "anchors" anchorSpec
+
+
+anchorSpec :: Spec
+anchorSpec = do
+  it "should encode an anchor" $ do
+    (out, _) <- runAsdfM . encodeNode $ Node mempty (Just "woot") "hello"
+    out `shouldBe` "&woot 'hello'\n"
+
+  it "should encode an alias" $ do
+    let alias = toNode $ Alias $ Anchor "something" :: Node
+    let anc = Node mempty (Just "something") "something"
+    (out, _) <- runAsdfM . encodeNode $ toNode $ Array [anc, alias]
+    out `shouldBe` "[&something 'something', *something]\n"
+
+  it "should not encode anchors to mappings" $ do
+    (out, _) <- runAsdfM . encodeNode $ Node mempty (Just "thing") (Object [("hello", "world")])
+    let outt = T.decodeUtf8 out
+    length (T.splitOn "&thing" outt) `shouldBe` 2
+    out `shouldBe` "&thing {hello: world}\n"
+
+  it "should not encode anchors to array members" $ do
+    (out, _) <- runAsdfM . encodeNode $ Node mempty (Just "thing") (Array ["one", "two"])
+    let outt = T.decodeUtf8 out
+    length (T.splitOn "&thing" outt) `shouldBe` 2
+    out `shouldBe` "&thing [one, two]\n"
+
+  it "should throw if alias before anchor" $ do
+    let vals = [toNode $ Alias "two", Node mempty (Just "two") "two"]
+    runAsdfM (encodeNode $ toNode (Array vals)) `shouldSatisfy` P.throws @AsdfError P.anything
+
+
+referenceSpec :: Spec
+referenceSpec = do
+  it "should encode a pointer" $ do
+    let ref = JSONReference mempty (jsonPointer "#/users/1/name")
+    (out, _) <- runAsdfM . encodeNode $ toNode $ Reference ref
+    out `shouldBe` "{$ref: '#/users/1/name'}\n"
+
+  it "should encode a reference" $ do
+    let ref = JSONReference "https://woot.com/" (jsonPointer "#/users/1/name")
+    (out, _) <- runAsdfM . encodeNode $ toNode $ Reference ref
+    out `shouldBe` "{$ref: 'https://woot.com/#/users/1/name'}\n"
+
+  it "should roundtrip reference" $ do
+    let ref = Reference $ JSONReference mempty (jsonPointer "#/users/1/name")
+    let tree = Object [("username", toNode ref)]
+    out <- encodeM tree
+    obj <- decodeM @Value out >>= expectObject
+    lookup "username" obj `shouldBe` Just (Node mempty Nothing ref)
+
+
+-- it "should rountrip and resolve references" $ do
+--   let pn = PointyName "pip"
+--   toValue pn `shouldBe` InternalRef (pointer "/names/2")
+--
+--   let pd = PointyData pn ["bob", "pip", "will"]
+--   out <- encodeM pd
+--   pd2 <- decodeM @PointyData out
+--
+--   pd2.other `shouldBe` PointyName "will"
+
+basicSpec :: Spec
+basicSpec = do
+  it "starts with required header lines" $ do
+    out <- encodeM (Object [])
+    (l1 : l2 : l3 : l4 : doc1 : _) <- pure $ BC.lines out
+    l1 `shouldBe` "#ASDF 1.0.0"
+    l2 `shouldBe` "#ASDF_STANDARD 1.5.0"
+    l3 `shouldBe` "%YAML 1.1"
+    l4 `shouldBe` "%TAG ! tag:stsci.edu:asdf/"
+    BS.take 4 doc1 `shouldBe` "--- "
+
+  it "should include history" $ do
+    out <- encodeM (Object [])
+    let (_, restL) = BS.breakSubstring "asdf_library:" out
+    BS.length restL `shouldNotBe` 0
+    let (_, restH) = BS.breakSubstring "history:" out
+    BS.length restH `shouldNotBe` 0
+
+  it "should throw if not an object" $ do
+    encodeM (Integer 100) `shouldSatisfy` P.throws @AsdfError P.anything
+
+
+streamSpec :: Spec
+streamSpec = do
+  it "should encode an empty string as empty single quotes" $ do
+    let unit = fromValue $ String ""
+    let obj = Object [("unit", unit)]
+    (out, _) <- runAsdfM . encodeNode $ toNode obj
+    out `shouldBe` "{unit: ''}\n"
+
+
+documentSpec :: Spec
+documentSpec = do
+  it "converts to document" $ do
+    asdf <- runAsdfM $ toAsdfDoc $ BasicData "henry"
+    asdf.library.name `shouldBe` "telescope.hs"
+    let Tree tree = asdf.tree
+    lookup "username" tree `shouldBe` Just "henry"
+
+
+blocksSpec :: Spec
+blocksSpec = do
+  it "includes blocks" $ do
+    let ns = [1 .. 100]
+    out <- encodeM (BasicArray ns)
+    af <- runAsdfM $ splitAsdfFile out
+    length af.blocks `shouldBe` 1
+
+    [BlockData bd] <- runAsdfM $ mapM decodeBlock af.blocks
+    bd `shouldBe` (toNDArray ns).bytes
+
+  describe "index" $ do
+    it "increeasing" $ do
+      let nd1 = toNDArray ([1 .. 10] :: [Int64])
+      let nd2 = toNDArray $ matrix @Int64 [[1, 2, 3], [4, 5, 6], [7, 8, 9]]
+      let blks = fmap (encodeBlock . BlockData) [nd1.bytes, nd2.bytes, nd1.bytes]
+      let tree = "1234567890"
+      let BlockIndex ix = blockIndex tree blks
+      length ix `shouldBe` 3
+      [i1, i2, i3] <- pure ix
+      let start = BS.length tree.bytes
+      i1 `shouldBe` start
+      i2 `shouldSatisfy` P.gt (start + (10 * 8))
+      i3 `shouldSatisfy` P.gt i2
+
+    it "equivalent to example.asdf" $ do
+      inp <- BS.readFile "samples/example.asdf"
+      e <- decodeM @Value inp
+      e `shouldSatisfy` P.con (Object P.anything)
+      af <- runAsdfM $ toAsdfDoc e >>= encodeAsdf
+      length af.blocks `shouldBe` 3
+
+      let BlockIndex ix = blockIndex af.tree af.blocks
+      length ix `shouldBe` 3
+      (i1 : _) <- pure ix
+
+      i1 `shouldBe` BS.length af.tree.bytes
+      fmap (subtract i1) ix `shouldBe` fmap (subtract 897) [897, 1751, 2605]
+
+    it "addresses blocks" $ do
+      inp <- BS.readFile "samples/example.asdf"
+      e <- decodeM @Value inp
+      o <- encodeM e
+      BlockIndex ix <- runAsdfM $ do
+        a <- toAsdfDoc e
+        af <- encodeAsdf a
+        pure $ blockIndex af.tree af.blocks
+      forM_ ix $ \n -> do
+        BS.take 4 (BS.drop n o) `shouldBe` blockMagicToken
+
+
+roundSpec :: Spec
+roundSpec = do
+  it "decodes encoded file" $ do
+    out <- encodeM (Object [("hello", "world")])
+    tree <- decodeM @Value out >>= expectObject
+    lookup "hello" tree `shouldSatisfy` P.just (P.eq "world")
+
+  it "encodes data type fields" $ do
+    out <- encodeM $ BasicData "hello"
+    let (_, nameRest) = BS.breakSubstring "username: hello" out
+    nameRest `shouldNotBe` ""
+
+  it "encodes simple ndarray" $ do
+    out <- encodeM $ BasicArray [1 .. 100]
+    BasicArray ns <- decodeM out
+    ns `shouldBe` [1 .. 100]
+
+  it "encodes massiv array" $ do
+    let mx = matrix [[1.0 .. 5.0], [2.0 .. 6.0]]
+    out <- encodeM $ Matrix mx
+
+    -- TEST: throws an error if NDArrayData.shape doesn't match
+    Matrix ns <- decodeM out
+    ns `shouldBe` mx
+
+  it "decodes encoded data type" $ do
+    let sd = SomeData 24 ["one", "two"] $ matrix [[1, 2, 3], [4, 5, 6]]
+    out <- encodeM sd
+    sd2 <- decodeM @SomeData out
+    sd2.number `shouldBe` sd.number
+    sd2.tags `shouldBe` sd.tags
+    sd2.matrix `shouldBe` sd.matrix
+
+
+externalSpec :: Spec
+externalSpec = do
+  it "saves encoded document to an asdf for external verification in python" $ do
+    let sd = SomeData 24 ["one", "two"] $ matrix [[1, 2, 3], [4, 5, 6]]
+    out <- encodeM sd
+    BS.writeFile "samples/generated.asdf" out
+
+
+matrix :: (M.Prim n) => [[n]] -> Array D Ix2 n
+matrix ns = M.delay @Ix2 @P $ M.fromLists' Seq ns
+
+
+newtype BasicArray = BasicArray [Int64]
+instance ToAsdf BasicArray where
+  toValue (BasicArray ns) =
+    Object
+      [("values", fromValue $ NDArray $ toNDArray ns)]
+instance FromAsdf BasicArray where
+  parseValue = \case
+    Object o -> do
+      nd <- o .: "values"
+      ns <- fromNDArray nd
+      pure $ BasicArray ns
+    val -> expected "BasicArray.values" val
+
+
+data Matrix = Matrix
+  { values :: Array D Ix2 Double
+  }
+  deriving (Generic, ToAsdf, FromAsdf)
+
+
+data BasicData = BasicData
+  { username :: Text
+  }
+  deriving (Generic, ToAsdf, FromAsdf)
+
+
+data SomeData = SomeData
+  { number :: Int
+  , tags :: [Text]
+  , matrix :: Array D Ix2 Int16
+  }
+  deriving (Generic, ToAsdf, FromAsdf)
+
+-- TEST: round trip file parts
+-- TEST: round trip is the only good way
+
+-- data PointyData = PointyData
+--   { other :: PointyName
+--   , names :: [Text]
+--   }
+--   deriving (Generic, FromAsdf, ToAsdf, Show, Eq)
+--
+--
+-- newtype PointyName = PointyName Text
+--   deriving (Show, Eq)
+-- instance ToAsdf PointyName where
+--   toValue (PointyName _) = InternalRef (pointer "/names/2")
+-- instance FromAsdf PointyName where
+--   parseValue = \case
+--     String s -> pure $ PointyName s
+--     InternalRef p -> parsePointer p
+--     other -> expected "PointyName Ref" other
diff --git a/test/Test/Asdf/FileSpec.hs b/test/Test/Asdf/FileSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Asdf/FileSpec.hs
@@ -0,0 +1,235 @@
+module Test.Asdf.FileSpec where
+
+import Data.Binary.Get
+import Data.Binary.Put
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
+import Data.ByteString.Lazy qualified as BL
+import Effectful
+import Effectful.NonDet
+import Effectful.State.Static.Local
+import Skeletest
+import Skeletest.Predicate ((>>>))
+import Skeletest.Predicate qualified as P
+import Telescope.Asdf.Encoding.File
+import Telescope.Asdf.Error
+
+
+spec :: Spec
+spec = do
+  describe "blocks" testBlocks
+  describe "split-file" testSplit
+
+
+testBlocks :: Spec
+testBlocks = do
+  let blockHeadZero = BlockHeader 1 0 NoCompression 0 0 0 noChecksum
+
+  describe "BlockHeader" $ do
+    it "should parse zero" $ do
+      let bh = runPut (putBlockHeader blockHeadZero)
+      goGet getBlockHeader bh `shouldBe` Right blockHeadZero
+
+    it "should create from data" $ do
+      let block = BlockData "hello"
+      let bh = blockHeader block
+
+      bh.allocatedSize `shouldBe` 5
+      bh.usedSize `shouldBe` 5
+      bh.allocatedSize `shouldBe` 5
+      bh.usedSize `shouldBe` 5
+      bh.dataSize `shouldBe` 5
+      bh.headerSize `shouldSatisfy` P.gte 48
+
+  describe "putBlock" $ do
+    it "puts a header" $ do
+      runPut (putBlockHeader blockHeadZero) `shouldSatisfy` (BL.length >>> P.gt 10)
+
+    it "puts a block" $ do
+      runPut (putBlock $ BlockData "hello") `shouldSatisfy` (BL.length >>> P.gt 10)
+
+  describe "getBlock" $ do
+    it "fails on empty data" $ do
+      goGet getBlock "" `shouldSatisfy` P.left P.anything
+
+    it "fails if missing magic byte" $ do
+      goGet getBlock "asdf" `shouldSatisfy` P.left P.anything
+
+    it "puts an empty block" $ do
+      let out = runPut (putBlock $ BlockData "")
+      goGet getBlock out `shouldBe` Right (BlockData "")
+
+  describe "getBlocks" $ do
+    it "looks ahead without failing" $ do
+      goGet checkMagicToken "asdf" `shouldBe` Right False
+
+    it "gets a single block" $ do
+      let out = runPut (putBlock $ BlockData "")
+      goGet getBlocks out `shouldBe` Right [BlockData ""]
+
+    it "gets empty array" $ do
+      goGet getBlocks "" `shouldBe` Right []
+ where
+  goGet a bs =
+    case runGetOrFail a bs of
+      Left e -> Left e
+      Right (_, _, x) -> Right x
+
+
+testSplit :: Spec
+testSplit = do
+  describe "parse tree" $ do
+    it "empty" $ do
+      t <- runParse "" parseTree
+      t `shouldBe` Encoded ""
+
+    it "tree only" $ do
+      (t, rest) <- runParse "value" $ do
+        t <- parseTree
+        rest <- get @ByteString
+        pure (t, rest)
+      t `shouldBe` Encoded "value"
+      rest `shouldBe` ""
+
+    it "tree with data" $ do
+      let Encoded bks = encodeBlock (BlockData "woot")
+      let inp = "value\n" <> bks
+      t <- runParse inp parseTree
+      t `shouldBe` Encoded "value\n"
+
+    it "tree with index" $ do
+      let Encoded ix = encodeIndex (BlockIndex [4])
+      let inp = "value\n" <> ix
+      (t, rest) <- runParse inp $ do
+        t <- parseTree
+        rest <- get @ByteString
+        pure (t, rest)
+      t `shouldBe` Encoded "value\n"
+      rest `shouldBe` ix
+
+    it "tree with all" $ do
+      let Encoded bks = encodeBlock (BlockData "woot")
+      let Encoded ix = encodeIndex (BlockIndex [4])
+      let inp = "value\n" <> bks <> ix
+      t <- runParse inp parseTree
+      t `shouldBe` Encoded "value\n"
+
+  describe "parse blocks" $ do
+    it "one block" $ do
+      let Encoded blks = encodeBlock (BlockData "woot")
+      n <- runParse blks parseBlock
+      n `shouldBe` Encoded blks
+
+    it "first block" $ do
+      let Encoded b1 = encodeBlock (BlockData "b1")
+      let Encoded b2 = encodeBlock (BlockData "b2")
+      b <- runParse (b1 <> b2) parseBlock
+      b `shouldBe` Encoded b1
+
+    it "block with index" $ do
+      let Encoded b1 = encodeBlock (BlockData "b1")
+      let Encoded ix = encodeIndex (BlockIndex [10])
+      let inp = b1 <> ix
+      n <- runParse inp parseBlock
+      n `shouldBe` Encoded b1
+
+    it "blocks" $ do
+      let Encoded b1 = encodeBlock (BlockData "b1")
+      let Encoded b2 = encodeBlock (BlockData "b2")
+      let inp = b1 <> b2
+      bs <- runParse inp parseBlocks
+      bs `shouldBe` [Encoded b1, Encoded b2]
+
+    it "blocks and index" $ do
+      let Encoded b1 = encodeBlock (BlockData "b1")
+      let Encoded b2 = encodeBlock (BlockData "b2")
+      let Encoded ix = encodeIndex (BlockIndex [10])
+      let inp = b1 <> b2 <> ix
+      bs <- runParse inp parseBlocks
+      bs `shouldBe` [Encoded b1, Encoded b2]
+
+  describe "basic data" $ do
+    it "should parse empty" $ do
+      af <- split ""
+      af `shouldBe` AsdfFile "" [] ""
+
+    it "just a tree" $ do
+      af <- split "tree"
+      af.tree `shouldBe` "tree"
+      af.blocks `shouldBe` []
+      af.index `shouldBe` ""
+
+  describe "optionals" $ do
+    it "tree + data!" $ do
+      let treeData = "#hello"
+      let tree = Encoded treeData
+      let blocks = [encodeBlock (BlockData "data")]
+      let ix = encodeIndex (blockIndex tree blocks)
+      let inp = concatAsdfFile $ AsdfFile{tree = Encoded treeData, blocks, index = ix}
+      af <- split inp
+      af.tree `shouldBe` "#hello"
+      af.blocks `shouldBe` blocks
+      af.index `shouldBe` ix
+
+    it "all parts" $ do
+      let treeData = "#hello\n"
+      let blocks = [encodeBlock (BlockData "data")]
+      let index = encodeIndex (BlockIndex [BS.length treeData])
+      let out = concatAsdfFile $ AsdfFile{tree = Encoded treeData, blocks, index}
+      af <- split out
+      af.tree `shouldBe` Encoded "#hello\n"
+      af.blocks `shouldBe` blocks
+      af.index `shouldBe` index
+
+    it "optional blocks" $ do
+      af <- split "asdf"
+      af `shouldBe` AsdfFile "asdf" [] ""
+
+    it "optional tree" $ do
+      let Encoded out = encodeBlock $ BlockData "hello"
+      af <- split out
+      af.tree `shouldBe` Encoded ""
+      af.blocks `shouldBe` [Encoded out]
+      af.index `shouldBe` ""
+
+    it "tree and index" $ do
+      let out = "tree\n" <> blockIndexHeader <> "index"
+      af <- split out
+      af.tree `shouldBe` "tree\n"
+      af.blocks `shouldBe` []
+      af.index `shouldBe` Encoded (blockIndexHeader <> "index")
+
+  describe "real asdf file" $ do
+    it "tree smaller than document " $ do
+      ExampleFileFix inp dp <- getFixture
+      BS.length dp.tree.bytes `shouldNotBe` BS.length inp
+
+    it "tree exists" $ do
+      ExampleFileFix _ dp <- getFixture
+      BS.length dp.tree.bytes `shouldSatisfy` P.gt 0
+
+    it "blocks exist" $ do
+      ExampleFileFix _ dp <- getFixture
+      length dp.blocks `shouldSatisfy` P.gt 0
+
+    it "index exists" $ do
+      ExampleFileFix _ dp <- getFixture
+      BS.length dp.index.bytes `shouldSatisfy` P.gt 0
+ where
+  split :: BS.ByteString -> IO AsdfFile
+  split inp = runAsdfM $ splitAsdfFile inp
+
+  runParse :: ByteString -> Eff [NonDet, State ByteString, IOE] a -> IO a
+  runParse inp eff = do
+    ret <- runEff . runState inp . runNonDet OnEmptyKeep $ eff
+    case ret of
+      (Left _, rest) -> fail $ "Failed parse at: " ++ show (BS.take 100 rest)
+      (Right a, _) -> pure a
+
+
+data ExampleFileFix = ExampleFileFix {input :: BS.ByteString, file :: AsdfFile}
+instance Fixture ExampleFileFix where
+  fixtureAction = do
+    inp <- BS.readFile "samples/example.asdf"
+    f <- runAsdfM $ splitAsdfFile inp
+    pure $ noCleanup $ ExampleFileFix inp f
diff --git a/test/Test/Asdf/GWCSSpec.hs b/test/Test/Asdf/GWCSSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Asdf/GWCSSpec.hs
@@ -0,0 +1,103 @@
+module Test.Asdf.GWCSSpec where
+
+import Data.List.NonEmpty qualified as NE
+import GHC.Generics (Generic)
+import Skeletest
+import Skeletest.Predicate qualified as P
+import Telescope.Asdf.Class
+import Telescope.Asdf.Core
+import Telescope.Asdf.GWCS
+import Telescope.Asdf.Node
+import Telescope.Data.WCS
+import Test.Asdf.ClassSpec (expectObject)
+
+
+data X deriving (Generic, ToAxes)
+data Y deriving (Generic, ToAxes)
+data Z deriving (Generic, ToAxes)
+
+
+spec :: Spec
+spec = do
+  describe "toAsdf" toAsdfSpec
+  describe "transforms" transformSpec
+
+
+toAsdfSpec :: Spec
+toAsdfSpec = do
+  describe "Coorindate Frames" $ do
+    it "should auto number axes order" $ do
+      o <- expectObject $ toValue frame
+      lookup "axes_order" o `shouldBe` Just (toNode @[Int] [0, 1])
+
+    it "should order composite frame" $ do
+      let frame2 = CoordinateFrame "boot" (NE.fromList [FrameAxis 2 "zero" "type" Pixel])
+      let comp = CompositeFrame (frame2, frame)
+      o <- expectObject $ toValue comp
+      case lookup "frames" o of
+        Just (Node _ _ (Array ns)) -> do
+          case ns of
+            [Node _ _ (Object f1), Node _ _ (Object f2)] -> do
+              lookup "axes_order" f1 `shouldBe` Just (toNode @[Int] [2])
+              lookup "axes_order" f2 `shouldBe` Just (toNode @[Int] [0, 1])
+            _ -> fail $ "Expected frame objects" ++ show ns
+        f -> fail $ "Expected frames" ++ show f
+ where
+  axes = [FrameAxis 0 "one" "type" Pixel, FrameAxis 1 "two" "type" Pixel]
+  frame = CoordinateFrame "woot" (NE.fromList axes)
+
+
+transformSpec :: Spec
+transformSpec = do
+  describe "linear" $ withMarkers ["focus"] $ do
+    it "should calculate intercept as 0th value for crval = 0" $ do
+      let wcs = WCSAxis{cunit = CUnit "cunit", ctype = CType "Ctype", crpix = 12.0, crval = 0, cdelt = 0.1}
+      let Intercept int = wcsIntercept wcs
+      int `shouldBe` (-1.1)
+
+    it "should calculate intercept with crval" $ do
+      let wcs = WCSAxis{cunit = CUnit "cunit", ctype = CType "Ctype", crpix = 12.0, crval = 1.0, cdelt = 0.1}
+      let Intercept int = wcsIntercept wcs
+      int `shouldSatisfy` P.approx P.tol (-0.1)
+
+  describe "(<&>) concatenate" $ withMarkers ["focus"] $ do
+    it "should combine two inputs" $ do
+      let tx = shift 10 :: Transform (Pix X) (Shift X)
+      let ty = shift 20 :: Transform (Pix Y) (Shift Y)
+      let total = tx <&> ty :: Transform (Pix X, Pix Y) (Shift X, Shift Y)
+      total.transformation.forward `shouldSatisfy` P.con (Concat P.anything P.anything)
+
+    it "should nest three inputs" $ do
+      let tx = shift 10 :: Transform (Pix X) (Shift X)
+      let ty = shift 20 :: Transform (Pix Y) (Shift Y)
+      let tz = shift 20 :: Transform (Pix Z) (Shift Z)
+      let total = tx <&> ty <&> tz :: Transform (Pix X, Pix Y, Pix Z) (Shift X, Shift Y, Shift Z)
+      total.transformation.forward `shouldSatisfy` P.con (Concat P.anything P.anything)
+      Concat txt tnext <- pure total.transformation.forward
+      txt `shouldBe` tx.transformation
+
+      tnext.forward `shouldSatisfy` P.con (Concat P.anything P.anything)
+      Concat tyt tzt <- pure tnext.forward
+      tyt `shouldBe` ty.transformation
+      tzt `shouldBe` tz.transformation
+
+  describe "concat and compose" $ withMarkers ["focus"] $ do
+    it "should compose with higher priority first" $ do
+      let tx = shift 10 :: Transform (Pix X) (Shift X)
+      let tx2 = scale 10 :: Transform (Shift X) (Scale X)
+      let ty = shift 20 :: Transform (Pix Y) (Shift Y)
+      let ty2 = scale 10 :: Transform (Shift Y) (Scale Y)
+      let total = tx |> tx2 <&> ty |> ty2 :: Transform (Pix X, Pix Y) (Scale X, Scale Y)
+
+      total.transformation.forward `shouldSatisfy` P.con (Concat P.anything P.anything)
+      Concat txt tyt <- pure total.transformation.forward
+
+      txt.forward `shouldSatisfy` P.con (Compose P.anything P.anything)
+      Compose txt1 txt2 <- pure txt.forward
+      txt1 `shouldBe` tx.transformation
+      txt2 `shouldBe` tx2.transformation
+
+      tyt.forward `shouldSatisfy` P.con (Compose P.anything P.anything)
+      Compose tyt1 tyt2 <- pure tyt.forward
+      tyt1 `shouldBe` ty.transformation
+      tyt2 `shouldBe` ty2.transformation
diff --git a/test/Test/Asdf/NDArraySpec.hs b/test/Test/Asdf/NDArraySpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Asdf/NDArraySpec.hs
@@ -0,0 +1,45 @@
+module Test.Asdf.NDArraySpec where
+
+import Control.Monad (replicateM)
+import Data.Binary.Get (runGet)
+import Data.ByteString qualified as BS
+import Data.ByteString.Lazy qualified as BL
+import GHC.Int
+import Skeletest
+import System.ByteOrder
+import Telescope.Asdf.NDArray (DataType (..), NDArrayData (..))
+import Telescope.Asdf.Node
+import Telescope.Data.Axes
+import Telescope.Data.Binary
+import Test.Asdf.DecodeSpec (ExampleTreeFix (..))
+
+
+spec :: Spec
+spec = do
+  -- can we correctly decode an array?
+  describe "DataType" $ do
+    -- TEST: parse bool8
+    -- TEST: parse uc4
+    pure ()
+
+  it "should parse NDArrayData" $ do
+    ExampleTreeFix (Tree tree) <- getFixture
+    nd <- expectNDArray $ lookup "sequence" tree
+    nd.byteorder `shouldBe` LittleEndian
+    nd.datatype `shouldBe` Int64
+    nd.shape `shouldBe` axesRowMajor [100]
+    BS.length nd.bytes `shouldBe` (100 * byteSize @Int64)
+
+  it "should contain data" $ do
+    ExampleTreeFix (Tree tree) <- getFixture
+    nd <- expectNDArray $ lookup "sequence" tree
+    decodeNums nd.bytes `shouldBe` [0 :: Int64 .. 99]
+ where
+  decodeNums bytes = do
+    runGet (replicateM 100 (get LittleEndian)) (BL.fromStrict bytes) :: [Int64]
+
+
+expectNDArray :: Maybe Node -> IO NDArrayData
+expectNDArray = \case
+  Just (Node _ _ (NDArray dat)) -> pure dat
+  n -> fail $ "Expected NDArray, but got: " ++ show n
diff --git a/test/Test/BinarySpec.hs b/test/Test/BinarySpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/BinarySpec.hs
@@ -0,0 +1,33 @@
+module Test.BinarySpec where
+
+import Data.Binary.Get
+import Data.Binary.Put
+import Data.ByteString.Lazy (ByteString)
+import GHC.Int
+import Skeletest
+import System.ByteOrder
+import Telescope.Data.Binary
+
+
+spec :: Spec
+spec = do
+  describe "BinaryValue" testBinaryValue
+
+
+testBinaryValue :: Spec
+testBinaryValue = do
+  it "should decode ints" $ do
+    get' @Int8 (put' @Int8 12) `shouldBe` 12
+    get' @Int16 (put' @Int16 12) `shouldBe` 12
+    get' @Int32 (put' @Int32 12) `shouldBe` 12
+    get' @Int64 (put' @Int64 12) `shouldBe` 12
+    get' @Int (put' @Int 12) `shouldBe` 12
+  it "should decode floats" $ do
+    get' @Float (put' @Float 12.21) `shouldBe` 12.21
+    get' @Double (put' @Double 12.21) `shouldBe` 12.21
+ where
+  get' :: (BinaryValue a) => ByteString -> a
+  get' = runGet (get BigEndian)
+
+  put' :: (BinaryValue a) => a -> ByteString
+  put' a = runPut (put BigEndian a)
diff --git a/test/Test/Fits/ChecksumSpec.hs b/test/Test/Fits/ChecksumSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Fits/ChecksumSpec.hs
@@ -0,0 +1,68 @@
+module Test.Fits.ChecksumSpec where
+
+import Data.ByteString qualified as BS
+import Data.Word
+import Skeletest
+import Telescope.Fits
+import Telescope.Fits.Checksum
+import Telescope.Fits.Encoding
+import Telescope.Fits.Types
+
+
+spec :: Spec
+spec = do
+  describe "checksum" specChecksum
+  describe "add1s" specOnesComplement
+
+
+specChecksum :: Spec
+specChecksum = do
+  describe "checksum" $ do
+    it "should calc zeros" $ do
+      let inp = BS.pack (replicate 100 0)
+      checksum inp `shouldBe` Checksum 0
+
+    it "should calc max" $ do
+      let inp = BS.pack (replicate 100 (maxBound :: Word8))
+      checksum inp `shouldBe` Checksum (maxBound :: Word32)
+
+    it "should be equal with trailing zeros" $ do
+      checksum (BS.pack [1, 2, 3, 4, 5]) `shouldBe` checksum (BS.pack [1, 2, 3, 4, 5, 0, 0, 0, 0, 0])
+
+    it "should not be equal with trailing spaces" $ do
+      checksum "12345" `shouldNotBe` checksum "12345     "
+
+  describe "datasum" $ do
+    it "should calc same datasum as astro.py" $ do
+      inp <- BS.readFile "./samples/ones10x10.fits"
+      f :: Fits <- decode inp
+
+      let datasumHeader = lookupKeyword "DATASUM" f.primaryHDU.header
+          datasumCalc = checksum f.primaryHDU.dataArray.rawData
+          datasumCalcHeader = Just $ checksumValue datasumCalc
+      datasumCalcHeader `shouldBe` datasumHeader
+
+  describe "encoding" $ do
+    it "checksum of empty HDU should be (-0)" $ do
+      let empty = PrimaryHDU (Header []) (DataArray BPInt8 (Axes []) "")
+      let out = encodePrimaryHDU empty
+      checksum out `shouldBe` Checksum maxBound
+
+    it "checksum of sample HDU should be (-0)" $ do
+      inp <- BS.readFile "./samples/ones10x10.fits"
+      f <- decode inp
+      let out = encodePrimaryHDU f.primaryHDU
+      checksum out `shouldBe` Checksum maxBound
+
+
+specOnesComplement :: Spec
+specOnesComplement = do
+  describe "add" $ do
+    it "max + 0" $ do
+      add1s maxBound 0 `shouldBe` maxBound
+
+    it "max + 1" $ do
+      add1s maxBound 1 `shouldBe` 1
+
+    it "max + max" $ do
+      add1s maxBound maxBound `shouldBe` maxBound
diff --git a/test/Test/Fits/ClassSpec.hs b/test/Test/Fits/ClassSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Fits/ClassSpec.hs
@@ -0,0 +1,118 @@
+module Test.Fits.ClassSpec where
+
+import Control.Monad.Catch (throwM)
+import Data.Fits as Fits hiding (isKeyword)
+import Data.Text (Text)
+import Effectful
+import Effectful.Error.Static
+import GHC.Generics
+import Skeletest
+import Skeletest.Predicate qualified as P
+import Telescope.Data.Axes
+import Telescope.Data.Parser
+import Telescope.Data.WCS
+import Telescope.Fits.Header
+
+
+spec :: Spec
+spec = do
+  describe "class" classSpec
+  describe "wcs" wcsSpec
+
+
+newtype Activity = Activity Text
+  deriving newtype (FromKeyword, ToKeyword)
+
+
+data Test = Test
+  { age :: Int
+  , firstName :: Text
+  }
+  deriving (Generic, ToHeader, FromHeader)
+
+
+data Woot = Woot
+  { woot :: Float
+  }
+  deriving (Generic, ToHeader)
+
+
+data Parent = Parent
+  { test :: HeaderFor Test
+  , woot :: HeaderFor Woot
+  }
+  deriving (Generic, ToHeader)
+
+
+classSpec :: Spec
+classSpec = do
+  describe "To/From KeywordValue" $ do
+    it "should toKeywordValue" $ do
+      toKeywordValue (23 :: Int) `shouldBe` Integer 23
+      toKeywordValue ("hello" :: Text) `shouldBe` String "hello"
+      toKeywordValue True `shouldBe` Logic T
+
+    it "should parseKeywordValue" $ do
+      runPureParser (parseKeywordValue @Int $ Integer 23) `shouldBe` Right 23
+      runPureParser (parseKeywordValue @Text $ String "woot") `shouldBe` Right "woot"
+      runPureParser (parseKeywordValue @Bool $ Logic F) `shouldBe` Right False
+
+  describe "ToHeader" $ do
+    it "should uppercase and snake keywords" $ do
+      let h = toHeader (Test 40 "Alice")
+      length h._records `shouldBe` 2
+      [Keyword (KeywordRecord k1 _ _), Keyword (KeywordRecord k2 _ _)] <- pure h._records
+      k1 `shouldBe` "AGE"
+      k2 `shouldBe` "FIRST_NAME"
+
+    it "should convert datatype" $ do
+      let h = toHeader (Test 40 "Alice")
+      lookupKeyword "AGE" h `shouldBe` Just (Integer 40)
+      lookupKeyword "FIRST_NAME" h `shouldBe` Just (String "Alice")
+
+  it "should mconcat fields that are members of toHeader" $ do
+    let h = toHeader $ Parent (HeaderFor $ Test 40 "Alice") (HeaderFor $ Woot 123.456)
+    lookupKeyword "age" h `shouldBe` Just (Integer 40)
+    lookupKeyword "first_name" h `shouldBe` Just (String "Alice")
+    lookupKeyword "woot" h `shouldSatisfy` P.just (P.con (Float (P.eq 123.456)))
+
+  describe "FromHeader" $ do
+    it "should convert datatype" $ do
+      let h = toHeader (Test 40 "Alice")
+      let et = runPureParser $ parseHeader h
+      et `shouldSatisfy` P.right (P.con Test{age = P.eq 40})
+      et `shouldSatisfy` P.right (P.con Test{firstName = P.eq "Alice"})
+
+
+data X
+instance AxisOrder X where
+  axisN = 1
+
+
+data Y
+instance AxisOrder Y where
+  axisN = 2
+
+
+wcsSpec :: Spec
+wcsSpec = do
+  describe "axis To/From Header" $ withMarkers ["focus"] $ do
+    it "should incorporate axis order into keywords" $ do
+      let hx = toHeader wcsX
+      Fits.lookup "CRPIX1" hx `shouldBe` Just (Float 1.0)
+
+    it "should incorporate wcsalt into keywords" $ do
+      let h = toHeader wcsAY
+      Fits.lookup "CRVAL2A" h `shouldBe` Just (Float 5.0)
+
+    it "should roundtrip" $ do
+      let h = toHeader wcsAY
+      wcs2 <- parseIO $ parseHeader h
+      wcs2 `shouldBe` wcsAY
+ where
+  wcsX = WCSAxis (CType "X") (CUnit "M") 1 2 3 :: WCSAxis 'WCSMain X
+  wcsAY = WCSAxis (CType "Y") (CUnit "M") 4 5 6 :: WCSAxis 'A Y
+
+
+parseIO :: Eff '[Parser, Error ParseError, IOE] a -> IO a
+parseIO p = runEff $ runErrorNoCallStackWith @ParseError throwM $ runParser p
diff --git a/test/Test/Fits/EncodingSpec.hs b/test/Test/Fits/EncodingSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Fits/EncodingSpec.hs
@@ -0,0 +1,296 @@
+{-# LANGUAGE TypeApplications #-}
+
+module Test.Fits.EncodingSpec where
+
+import Data.ByteString qualified as BS
+import Data.ByteString.Lazy qualified as BL
+import Data.ByteString.Lazy.Char8 qualified as C8
+import Data.Massiv.Array (Ix2)
+import Data.Massiv.Array qualified as M
+import Data.Text (pack)
+import Skeletest
+import Telescope.Fits.DataArray
+import Telescope.Fits.Encoding
+import Telescope.Fits.Encoding.Render hiding (justify, pad, spaces)
+import Telescope.Fits.Header
+import Telescope.Fits.Types
+
+
+spec :: Spec
+spec = do
+  describe "decode fits" testDecodeFits
+  describe "render header" testRenderHeader
+  describe "render data" testRenderData
+  describe "encode primary" testEncodePrimary
+  describe "round trip" testRoundTrip
+
+
+testDecodeFits :: Spec
+testDecodeFits = do
+  describe "simple2x3.fits" $ do
+    it "should load metadata" $ do
+      f <- decode =<< BS.readFile "samples/simple2x3.fits"
+      let dat = f.primaryHDU.dataArray
+          hds = f.primaryHDU.header
+      dat.axes `shouldBe` Axes [3, 2]
+      dat.bitpix `shouldBe` BPInt64
+      lookupKeyword "CUSTOM" hds `shouldBe` Just (Integer 123456)
+
+    it "should load data array" $ do
+      f <- decode =<< BS.readFile "samples/simple2x3.fits"
+      arr <- decodeDataArray @Ix2 @Int f.primaryHDU.dataArray
+      M.toLists arr `shouldBe` [[0, 1, 2], [3, 4, 5]]
+
+  describe "NSO L2 Data" $ do
+    it "should load" $ do
+      f <- decode =<< BS.readFile "samples/dkistL2.fits"
+      length f.extensions `shouldBe` 1
+
+
+-- arr <- decodeDataArray @Ix2 @Int f.primaryHDU.dataArray
+-- M.toLists arr `shouldBe` [[0, 1, 2], [3, 4, 5]]
+
+testRenderHeader :: Spec
+testRenderHeader = do
+  describe "renderValue" $ do
+    it "int should right justify" $ do
+      runValue (Integer 8) `shouldBe` justify 20 "8"
+
+    it "float should right justify" $ do
+      runValue (Float 3.2) `shouldBe` justify 20 "3.2"
+
+    it "negative int" $ do
+      runValue (Integer (-32)) `shouldBe` justify 20 "-32"
+
+    it "negative float" $ do
+      runValue (Float (-32.32)) `shouldBe` justify 20 "-32.32"
+
+    it "float should exponent uppercase" $ do
+      runValue (Float 6.0001e-16) `shouldBe` justify 20 "6.0001E-16"
+
+    it "logic should right justify" $ do
+      runValue (Logic T) `shouldBe` justify 20 "T"
+
+    it "string" $ do
+      runValue (String "Hello World") `shouldBe` "'Hello World'"
+
+  -- TEST: does it matter if e-06 vs e-6? We output e-6.
+
+  describe "renderKeyword" $ do
+    it "should left justify" $ do
+      run (renderKeyword "BITPIX") `shouldBe` "BITPIX  "
+
+    it "should truncate" $ do
+      run (renderKeyword "REALLYLONG") `shouldBe` "REALLYLO"
+
+    it "should uppercase" $ do
+      run (renderKeyword "lower") `shouldBe` "LOWER   "
+
+  describe "renderKeywordValue" $ do
+    it "should render space" $ do
+      run (renderKeywordValue "SIMPLE" (Logic T)) `shouldBe` ("SIMPLE  = " <> justify 20 "T")
+
+    it "should butt against equals" $ do
+      run (renderKeywordValue "WHATEVER" (Integer 10)) `shouldBe` ("WHATEVER= " <> justify 20 "10")
+
+    it "should string" $ do
+      run (renderKeywordValue "WHATEVER" (String "dude")) `shouldBe` pad 30 "WHATEVER= 'dude'"
+
+    it "should correctly count long values" $ do
+      let render = renderKeywordValue "KEYWORD" (String "0123456789012345678901234567890123456789")
+      render.length `shouldBe` length (run render)
+
+  describe "renderComment" $ do
+    it "should render comment" $ do
+      run (renderComment 100 "Hello World") `shouldBe` " / Hello World"
+
+    it "should truncate comment" $ do
+      run (renderComment 10 "Hello World") `shouldBe` " / Hello W"
+
+  describe "renderKeywordComments" $ do
+    it "should render comment in line" $ do
+      run (renderKeywordLine "SIMPLE" (Logic T) (Just "Comment")) `shouldBe` pad 80 ("SIMPLE  = " <> justify 20 "T" <> " / Comment")
+
+    it "should render no comment" $ do
+      run (renderKeywordLine "SIMPLE" (Logic T) Nothing) `shouldBe` pad 80 ("SIMPLE  = " <> justify 20 "T")
+
+    it "should truncate whole line" $ do
+      run (renderKeywordLine "SIMPLE" (Logic T) Nothing) `shouldBe` pad 80 ("SIMPLE  = " <> justify 20 "T")
+
+  describe "renderKeywordLine" $ do
+    it "should be 80 characters mininum" $ do
+      let b = renderKeywordLine "HELLO" (Integer 1) Nothing
+      b.length `shouldBe` 80
+
+    it "should be 80 characters maximum" $ do
+      let b = renderKeywordLine "HELLO" (Integer 1) (Just $ pack $ replicate 100 'a')
+      b.length `shouldBe` 80
+
+    it "should be 80 characters maximum with long strings" $ do
+      let b = renderKeywordLine "HELLO" (String "this is a really long value that exceeds 20") (Just $ pack $ replicate 100 'a')
+      b.length `shouldBe` 80
+      length (run b) `shouldBe` 80
+
+    it "should be padded" $ do
+      run (renderKeywordLine "HELLO" (Integer 1) Nothing) `shouldBe` "HELLO   = " <> justify 20 "1" <> spaces 50
+
+  describe "renderOtherKeywords" $ do
+    it "should render comments" $ do
+      let h = Header [Comment "hello world"]
+      run (renderOtherKeywords h) `shouldBe` pad 80 "COMMENT hello world"
+
+    it "should render blanks" $ do
+      let h = Header [BlankLine, Keyword (KeywordRecord "WOOT" (Integer 12345) Nothing)]
+      run (renderOtherKeywords h) `shouldBe` headers ["", "WOOT    = " <> justify 20 "12345"]
+
+    it "should render blanks between" $ do
+      let h = Header [Comment "comment", BlankLine, Keyword (KeywordRecord "WOOT" (Integer 12345) Nothing)]
+      run (renderOtherKeywords h) `shouldBe` headers ["COMMENT comment", "", "WOOT    = " <> justify 20 "12345"]
+ where
+  runValue :: Value -> String
+  runValue = run . renderValue
+
+
+run :: BuilderBlock -> String
+run = C8.unpack . runRender
+
+
+headers :: [String] -> String
+headers = mconcat . map (pad 80)
+
+
+justify :: Int -> String -> String
+justify n s = spaces (n - length s) <> s
+
+
+pad :: Int -> String -> String
+pad n s = s <> spaces (n - length s)
+
+
+spaces :: Int -> String
+spaces n = replicate n ' '
+
+
+testRenderData :: Spec
+testRenderData = do
+  it "fill block should fill" $ do
+    (fillBlock zeros "a").length `shouldBe` 2880
+    (fillBlock zeros "hello world").length `shouldBe` 2880
+    (fillBlock zeros "").length `shouldBe` 0
+
+  it "should be empty" $ do
+    runRender (renderData "") `shouldBe` ""
+
+  it "should pad to nearest block" $ do
+    (renderData "asdf").length `shouldBe` 2880
+
+  it "should render some data" $ do
+    runRender (renderData "12345") `shouldBe` ("12345" <> BL.replicate 2875 0)
+
+
+testEncodePrimary :: Spec
+testEncodePrimary = do
+  describe "encoded primary hdu" $ do
+    it "encodes both a header and data hdu" $ do
+      FitsEncodedFix enc <- getFixture
+      BS.length enc `shouldBe` hduBlockSize * 2
+
+    it "encodes the data" $ do
+      FitsEncodedFix enc <- getFixture
+      BS.take 6 (BS.drop 2880 enc) `shouldBe` rawData
+
+    it "starts with SIMPLE" $ do
+      FitsEncodedFix enc <- getFixture
+      BS.take 30 enc `shouldBe` "SIMPLE  =                    T"
+
+  describe "decoded encoded primary hdu" $ do
+    it "Has custom header" $ do
+      FitsDecodedFix f <- getFixture
+      lookupKeyword "WOOT" f.primaryHDU.header `shouldBe` Just (Integer 123)
+
+    it "Has required headers" $ do
+      FitsDecodedFix f <- getFixture
+      lookupKeyword "EXTEND" f.primaryHDU.header `shouldBe` Just (Logic T)
+
+    it "Matches data metadata" $ do
+      FitsDecodedFix f <- getFixture
+      f.primaryHDU.dataArray.bitpix `shouldBe` BPInt8
+      f.primaryHDU.dataArray.axes `shouldBe` Axes [3, 2]
+
+    it "Matches raw data" $ do
+      FitsDecodedFix f <- getFixture
+      f.primaryHDU.dataArray.rawData `shouldBe` BS.pack [0 .. 5]
+ where
+  rawData = BS.pack [0 .. 5]
+
+
+testRoundTrip :: Spec
+testRoundTrip = do
+  describe "simple2x3.fits" $ do
+    it "should match metadata" $ do
+      Simple2x3Fix fs <- getFixture
+      f2 <- decode $ encode fs
+      f2.primaryHDU.dataArray.axes `shouldBe` Axes [3, 2]
+      f2.primaryHDU.dataArray.bitpix `shouldBe` fs.primaryHDU.dataArray.bitpix
+
+    it "should match raw data" $ do
+      Simple2x3Fix fs <- getFixture
+      f2 <- decode $ encode fs
+      f2.primaryHDU.dataArray.rawData `shouldBe` fs.primaryHDU.dataArray.rawData
+
+    it "should encode headers only once" $ do
+      Simple2x3Fix fs <- getFixture
+      f2 <- decode $ encode fs
+      let hs = fs.primaryHDU.header
+          h2 = f2.primaryHDU.header
+      lookupKeyword "NAXIS" h2 `shouldBe` Just (Integer 2)
+
+      let ks = getKeywords hs :: [KeywordRecord]
+          k2 = getKeywords h2 :: [KeywordRecord]
+
+      length (filter (matchKeyword "BITPIX") k2) `shouldBe` length (filter (matchKeyword "BITPIX") ks)
+
+      length h2._records `shouldBe` length hs._records
+
+    it "should keep naxes order preserved" $ do
+      Simple2x3Fix fs <- getFixture
+      f2 <- decode $ encode fs
+      f2.primaryHDU.dataArray.axes `shouldBe` fs.primaryHDU.dataArray.axes
+
+  describe "image fits" $ do
+    it "should roundtrip image extensions" $ do
+      let prim = PrimaryHDU mempty emptyDataArray
+      let img = Image $ ImageHDU mempty emptyDataArray
+      let out = encode $ Fits prim [img]
+      fits2 <- decode out
+      length fits2.extensions `shouldBe` 1
+ where
+  matchKeyword k (KeywordRecord k2 _ _) = k == k2
+
+
+newtype Simple2x3Fix = Simple2x3Fix Fits
+instance Fixture Simple2x3Fix where
+  fixtureAction = do
+    inp <- BS.readFile "samples/simple2x3.fits"
+    fits <- decode inp
+    pure $ noCleanup $ Simple2x3Fix fits
+
+
+newtype FitsEncodedFix = FitsEncodedFix BS.ByteString
+instance Fixture FitsEncodedFix where
+  fixtureAction = do
+    pure $ noCleanup $ FitsEncodedFix encoded
+   where
+    encoded = encode (Fits primary [])
+    primary =
+      let heads = Header [Keyword $ KeywordRecord "WOOT" (Integer 123) Nothing]
+          dat = DataArray BPInt8 (Axes [3, 2]) $ BS.pack [0 .. 5]
+       in PrimaryHDU heads dat
+
+
+newtype FitsDecodedFix = FitsDecodedFix Fits
+instance Fixture FitsDecodedFix where
+  fixtureAction = do
+    FitsEncodedFix enc <- getFixture
+    f <- decode enc
+    pure $ noCleanup $ FitsDecodedFix f