diff --git a/Setup.hs b/Setup.hs
deleted file mode 100644
--- a/Setup.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-import Distribution.Simple
-main = defaultMain
diff --git a/just-some-usage-code-that-must-compile/Main.hs b/just-some-usage-code-that-must-compile/Main.hs
deleted file mode 100644
--- a/just-some-usage-code-that-must-compile/Main.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-main :: IO ()
-main = putStrLn "All done"
diff --git a/just-some-usage-code-that-must-compile/SomeUsageOfImplicitApi.hs b/just-some-usage-code-that-must-compile/SomeUsageOfImplicitApi.hs
deleted file mode 100644
--- a/just-some-usage-code-that-must-compile/SomeUsageOfImplicitApi.hs
+++ /dev/null
@@ -1,55 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeApplications #-}
-
-module SomeUsageOfImplicitApi where
-
-import Control.Concurrent
-import Control.Concurrent.Async
-import Control.Monad
-import OpenTelemetry.Common
-import OpenTelemetry.FileExporter
-import OpenTelemetry.Implicit
-
-main :: IO ()
-main = do
-  exporter <- createFileSpanExporter "helloworld.trace"
-  let otConfig =
-        OpenTelemetryConfig
-          { otcSpanExporter = exporter
-          }
-  withOpenTelemetry otConfig $ do
-    result <- pieceOfSeriousBusinessLogic 42
-    print result
-
-pieceOfSeriousBusinessLogic :: Int -> IO Int
-pieceOfSeriousBusinessLogic input = withSpan "serious business" $ do
-  let result = 2 * input
-  -- setTag is value-polymorphic
-
-  -- setTag "input" input -- Int (inferred)
-  -- setTag @Int "result" result -- Int (explicit)
-  -- setTag @String "seriousness" "serious" -- literals are polymorphic under OverloadedStrings so we need to annotate
-  -- setTag @Double "profit" 99 -- numeric literals are also polymorphic
-  -- setTag "error" False -- Bool literals are not polymorphic
-  -- setTag @Int "largest integer below 100" 99 -- Int (inferred)
-
-  -- TODO: JSON values
-
-  addEvent "log" "rpc roundtrip begin"
-  withSpan "leveraging synergies" $ do
-    threadDelay 10000
-    addEvent "log" "enough synergies leveraged"
-  addEvent "log" "All your base are belong to us"
-  addEvent "log" "rpc roundtrip end"
-  withSpan "project" $ do
-    -- Connecting spans across threads requires some manual plumbing
-    Just sp <- getCurrentActiveSpan
-    asyncWork <- async $ withChildSpanOf sp "data science" $ do
-      threadDelay 1000000
-      pure 42
-    -- Doing a withSpan inside a loop is fine
-    forM_ [input .. input + 10] $ \i -> withSpan "sprint" $ do
-      -- setTag "week" i
-      threadDelay 10000
-    wait asyncWork
-  pure result
diff --git a/opentelemetry.cabal b/opentelemetry.cabal
--- a/opentelemetry.cabal
+++ b/opentelemetry.cabal
@@ -2,7 +2,7 @@
 name:                opentelemetry
 description:         The OpenTelemetry Haskell Client https://opentelemetry.io
 category:            OpenTelemetry
-version:             0.2.0
+version:             0.3.0
 license-file:        LICENSE
 license:             Apache-2.0
 author:              Dmitry Ivanov
@@ -41,7 +41,6 @@
     -Wincomplete-record-updates
     -Wincomplete-uni-patterns
     -Wpartial-fields
-    -Wredundant-constraints
     -fhide-source-paths
     -ferror-spans
     -freverse-errors
@@ -49,49 +48,12 @@
 library
   import: options
   build-depends:
-    base >= 4.12 && < 5,
+    base >= 4.11 && < 5,
     bytestring,
-    clock >= 0.8,
-    directory,
-    exceptions,
-    hashable,
-    random >= 1.1,
-    stm,
-    text,
-    unordered-containers
+    exceptions
   hs-source-dirs: src
   exposed-modules:
-    OpenTelemetry.Common
-    OpenTelemetry.Debug
-    OpenTelemetry.FileExporter
-    OpenTelemetry.Implicit
+    OpenTelemetry.SpanContext
+    OpenTelemetry.Exporter
     OpenTelemetry.Propagation
-
-test-suite just-some-usage-code-that-must-compile
-  import: options
-  type:       exitcode-stdio-1.0
-  main-is:    Main.hs
-  other-modules:
-    SomeUsageOfImplicitApi
-  hs-source-dirs: just-some-usage-code-that-must-compile
-  build-depends:
-    base,
-    async,
-    opentelemetry
-
-test-suite unit-tests
-  import: options
-  type:       exitcode-stdio-1.0
-  main-is:    Main.hs
-  other-modules:
-    TestCommon
-    TestPropagation
-  hs-source-dirs: unit-tests
-  build-depends:
-    base,
-    bytestring,
-    tasty,
-    tasty-quickcheck,
-    tasty-hunit,
-    tasty-discover,
-    opentelemetry
+    OpenTelemetry.Eventlog
diff --git a/src/OpenTelemetry/Common.hs b/src/OpenTelemetry/Common.hs
deleted file mode 100644
--- a/src/OpenTelemetry/Common.hs
+++ /dev/null
@@ -1,153 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module OpenTelemetry.Common where
-
-import qualified Data.HashMap.Strict as HM
-import Data.Hashable
-import GHC.Generics
-import qualified Data.List.NonEmpty as NE
-import Data.List.NonEmpty (NonEmpty ((:|)), (<|))
-import qualified Data.Text as T
-import Data.Word
-import System.Clock
-import Text.Printf
-
-newtype TraceId = TId Word64
-  deriving (Eq, Generic)
-  deriving (Hashable) via Word64
-
-instance Show TraceId where
-  show (TId tid) = printf "TraceId %x" tid
-
-newtype SpanId = SId Word64
-  deriving (Eq, Generic)
-  deriving (Hashable) via Word64
-
-instance Show SpanId where
-  show (SId sid) = printf "SpanId %x" sid
-
-type Timestamp = Word64
-
-data Tracer threadId
-  = Tracer
-      { tracerSpanStacks :: !(HM.HashMap threadId (NE.NonEmpty Span))
-      }
-      deriving (Eq, Show)
-
-tracerPushSpan :: (Eq tid, Hashable tid) => Tracer tid -> tid -> Span -> Tracer tid
-tracerPushSpan t@(Tracer {..}) tid sp =
-  case HM.lookup tid tracerSpanStacks of
-    Nothing ->
-      let !stacks = HM.insert tid (sp :| []) tracerSpanStacks
-      in Tracer stacks
-    Just sps ->
-      let !stacks = HM.insert tid (sp <| sps) tracerSpanStacks
-      in t { tracerSpanStacks = stacks }
-
-tracerPopSpan :: (Eq tid, Hashable tid) => Tracer tid -> tid -> (Maybe Span, Tracer tid)
-tracerPopSpan t@(Tracer {..}) tid =
-  case HM.lookup tid tracerSpanStacks of
-    Nothing -> (Nothing, t)
-    Just (sp :| sps) ->
-      let stacks =
-            case NE.nonEmpty sps of
-              Nothing -> HM.delete tid tracerSpanStacks
-              Just sps' -> HM.insert tid sps' tracerSpanStacks
-       in (Just sp, Tracer stacks)
-
-tracerGetCurrentActiveSpan :: (Hashable tid, Eq tid) => Tracer tid -> tid -> Maybe Span
-tracerGetCurrentActiveSpan (Tracer stacks) tid =
-  case HM.lookup tid stacks of
-    Nothing -> Nothing
-    Just (sp NE.:| _) -> Just sp
-
-createTracer :: (Hashable tid, Eq tid) => IO (Tracer tid)
-createTracer = pure $ Tracer mempty
-
-data SpanContext = SpanContext !SpanId !TraceId
-  deriving (Show, Eq, Generic)
-
-data TagValue
-  = StringTagValue !T.Text
-  | BoolTagValue !Bool
-  | IntTagValue !Int
-  | DoubleTagValue !Double
-  deriving (Eq, Show)
-
-class ToTagValue a where
-  toTagValue :: a -> TagValue
-
-instance ToTagValue String where
-  toTagValue = StringTagValue . T.pack
-
-instance ToTagValue T.Text where
-  toTagValue = StringTagValue
-
-instance ToTagValue Bool where
-  toTagValue = BoolTagValue
-
-instance ToTagValue Int where
-  toTagValue = IntTagValue
-
-data Span
-  = Span
-      { spanContext :: {-# UNPACK #-} !SpanContext,
-        spanOperation :: T.Text,
-        spanStartedAt :: !Timestamp,
-        spanFinishedAt :: !Timestamp,
-        spanTags :: !(HM.HashMap T.Text TagValue),
-        spanEvents :: [SpanEvent],
-        spanStatus :: !SpanStatus,
-        spanParentId :: Maybe SpanId
-      }
-  deriving (Show, Eq)
-
-spanTraceId :: Span -> TraceId
-spanTraceId Span {spanContext = SpanContext _ tid} = tid
-
-spanId :: Span -> SpanId
-spanId Span {spanContext = SpanContext sid _} = sid
-
-data SpanEvent = SpanEvent
-  { spanEventTimestamp :: !Timestamp
-  , spanEventKey :: !T.Text
-  , spanEventValue :: !T.Text
-  } deriving (Show, Eq)
-
-data SpanStatus = OK
-  deriving (Show, Eq)
-
-data Event
-  = Event T.Text Timestamp
-  deriving (Show, Eq)
-
-data SpanProcessor
-  = SpanProcessor
-      { onStart :: Span -> IO (),
-        onEnd :: Span -> IO ()
-      }
-
-data ExportResult
-  = ExportSuccess
-  | ExportFailedRetryable
-  | ExportFailedNotRetryable
-  deriving (Show, Eq)
-
-data Exporter thing
-  = Exporter
-      { export :: [thing] -> IO ExportResult,
-        shutdown :: IO ()
-      }
-
-data OpenTelemetryConfig
-  = OpenTelemetryConfig
-      { otcSpanExporter :: Exporter Span
-      }
-
-noopExporter :: Exporter whatever
-noopExporter = Exporter (const (pure ExportFailedNotRetryable)) (pure ())
-
-now64 :: IO Timestamp
-now64 = do
-  TimeSpec secs nsecs <- getTime Realtime
-  pure $! fromIntegral secs * 1_000_000_000 + fromIntegral nsecs
diff --git a/src/OpenTelemetry/Debug.hs b/src/OpenTelemetry/Debug.hs
deleted file mode 100644
--- a/src/OpenTelemetry/Debug.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-module OpenTelemetry.Debug where
-
-import Control.Concurrent.STM
-import Control.Monad.IO.Class
-import System.Environment
-import System.IO
-import System.IO.Unsafe
-
-dd_ :: Show a => String -> a -> IO ()
-dd_ = unsafePerformIO $
-  lookupEnv "OPENTELEMETRY_DEBUG" >>= \case
-    Nothing -> pure $ \_ _ -> pure ()
-    Just "0" -> pure $ \_ _ -> pure ()
-    Just "false" -> pure $ \_ _ -> pure ()
-    _ -> pure $ \s thing -> liftIO $ do
-      hPutStr stderr (s <> ": ")
-      hPutStrLn stderr (show thing)
-{-# NOINLINE dd_ #-}
-
-inc :: Int -> TVar Int -> IO ()
-inc amount counterVar = atomically $ modifyTVar counterVar (+ amount)
diff --git a/src/OpenTelemetry/Eventlog.hs b/src/OpenTelemetry/Eventlog.hs
new file mode 100644
--- /dev/null
+++ b/src/OpenTelemetry/Eventlog.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module OpenTelemetry.Eventlog where
+
+import Control.Monad.Catch
+import Control.Monad.IO.Class
+import qualified Data.ByteString.Char8 as BS8
+import Debug.Trace
+import OpenTelemetry.SpanContext
+import Text.Printf
+
+-- TODO(divanov): replace traceEventIO with the bytestring based equivalent
+
+beginSpan :: MonadIO m => String -> m ()
+beginSpan operation = liftIO $ traceEventIO (printf "ot1 begin span %s" operation)
+
+endSpan :: MonadIO m => m ()
+endSpan = liftIO $ traceEventIO (printf "ot1 end span")
+
+setTag :: MonadIO m => String -> BS8.ByteString -> m ()
+setTag k v = liftIO $ traceEventIO (printf "ot1 set tag %s %s" k (BS8.unpack v))
+
+addEvent :: MonadIO m => String -> BS8.ByteString -> m ()
+addEvent k v = liftIO $ traceEventIO (printf "ot1 add event %s %s" k (BS8.unpack v))
+
+setParentSpanContext :: MonadIO m => SpanContext -> m ()
+setParentSpanContext (SpanContext (SId sid) (TId tid)) =
+  liftIO $ traceEventIO (printf "ot1 set parent %016x %016x" tid sid)
+
+setTraceId :: MonadIO m => TraceId -> m ()
+setTraceId (TId tid) =
+  liftIO $ traceEventIO (printf "ot1 set traceid %016x" tid)
+
+setSpanId :: MonadIO m => SpanId -> m ()
+setSpanId (SId sid) =
+  liftIO $ traceEventIO (printf "ot1 set spanid %016x" sid)
+
+withSpan :: forall m a. (MonadIO m, MonadMask m) => String -> m a -> m a
+withSpan operation action =
+  fst
+    <$> generalBracket
+      (liftIO $ beginSpan operation)
+      ( \_span exitcase -> liftIO $ do
+          case exitcase of
+            ExitCaseSuccess _ -> pure ()
+            ExitCaseException e -> do
+              setTag "error" "true"
+              setTag "error.message" (BS8.pack $ show e)
+            ExitCaseAbort -> do
+              setTag "error" "true"
+              setTag "error.message" "abort"
+          liftIO endSpan
+      )
+      (\_span -> action)
diff --git a/src/OpenTelemetry/Exporter.hs b/src/OpenTelemetry/Exporter.hs
new file mode 100644
--- /dev/null
+++ b/src/OpenTelemetry/Exporter.hs
@@ -0,0 +1,16 @@
+module OpenTelemetry.Exporter where
+
+data ExportResult
+  = ExportSuccess
+  | ExportFailedRetryable
+  | ExportFailedNotRetryable
+  deriving (Show, Eq)
+
+data Exporter thing
+  = Exporter
+      { export :: [thing] -> IO ExportResult,
+        shutdown :: IO ()
+      }
+
+noopExporter :: Exporter whatever
+noopExporter = Exporter (const (pure ExportFailedNotRetryable)) (pure ())
diff --git a/src/OpenTelemetry/FileExporter.hs b/src/OpenTelemetry/FileExporter.hs
deleted file mode 100644
--- a/src/OpenTelemetry/FileExporter.hs
+++ /dev/null
@@ -1,59 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module OpenTelemetry.FileExporter where
-
-import Data.Function
-import qualified Data.HashMap.Strict as HM
-import Data.List
-import qualified Data.Text as T
-import OpenTelemetry.Common
-import System.IO
-import Text.Printf
-import Text.Read
-
-showValue :: TagValue -> String
-showValue (StringTagValue s) = show s
-showValue (IntTagValue i) = show i
-showValue _ = "\"unknown\""
-
-showSpan :: Span -> String
-showSpan s@(Span {..}) =
-  let (TId tid) = spanTraceId s
-      threadId = case HM.lookup "thread_id" spanTags of
-        Just (StringTagValue (T.stripPrefix "ThreadId " -> Just (readMaybe . T.unpack -> Just t))) -> t
-        Just (IntTagValue t) -> t
-        _ -> 1
-      meta :: String
-      meta =
-        spanTags
-          & HM.toList
-          & map (\(k, v) -> ["\"", T.unpack k, "\":", showValue v])
-          & ([printf "\"traceId\":\"%x\"" tid] :)
-          & intersperse [","]
-          & concat
-          & concat
-   in printf
-        "{\"ph\":\"B\",\"name\":\"%s\",\"pid\":1,\"ts\":%d,\"tid\":%d,\"args\":{%s}},{\"ph\":\"E\",\"name\":\"%s\",\"pid\":1,\"ts\":%d,\"tid\":%d},"
-        spanOperation
-        (div spanStartedAt 1000)
-        threadId
-        meta
-        spanOperation
-        (div spanFinishedAt 1000)
-        threadId
-
-createFileSpanExporter :: FilePath -> IO (Exporter Span)
-createFileSpanExporter path = do
-  f <- openFile path WriteMode
-  hPutStrLn f "["
-  pure
-    $! Exporter
-      ( \sps -> do
-          mapM_ (hPutStrLn f . showSpan) sps
-          pure ExportSuccess
-      )
-      ( do
-          hSeek f RelativeSeek (-2) -- overwrite the last comma
-          hPutStrLn f "\n]"
-          hClose f
-      )
diff --git a/src/OpenTelemetry/Implicit.hs b/src/OpenTelemetry/Implicit.hs
deleted file mode 100644
--- a/src/OpenTelemetry/Implicit.hs
+++ /dev/null
@@ -1,150 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module OpenTelemetry.Implicit where
-
-import Control.Concurrent
-import Control.Monad.Catch
-import Control.Monad.IO.Class
-import qualified Data.HashMap.Strict as HM
-import Data.List.NonEmpty (NonEmpty ((:|)))
-import qualified Data.Text as T
-import OpenTelemetry.Common
-import OpenTelemetry.FileExporter
-import System.Directory
-import System.Environment
-import System.IO.Unsafe
-import System.Random
-import Text.Printf
-
-data SpanChildness = Root | ChildOf Span
-
-data AutoTagError = DoAutoTagError | Don'tAutoTagError
-
-withSpan :: (MonadIO m, MonadMask m) => String -> m a -> m a
-withSpan = generalWithSpan (WithSpanOptions Root DoAutoTagError)
-
-data WithSpanOptions
-  = WithSpanOptions
-      { childness :: SpanChildness,
-        autoTagError :: AutoTagError
-      }
-
-generalWithSpan :: (MonadIO m, MonadMask m) => WithSpanOptions -> String -> m a -> m a
-generalWithSpan WithSpanOptions {childness, autoTagError} operation action = do
-  threadId <- liftIO myThreadId
-  sid <- liftIO randomIO
-  startedAt <- liftIO now64
-  (result, ()) <-
-    generalBracket
-      ( liftIO $ modifyMVar_ globalSharedMutableState $ \GlobalSharedMutableState {..} -> do
-          let (!mpsid, !ctx) = case (childness, HM.lookup threadId (tracerSpanStacks gTracer)) of
-                (ChildOf parent, _) -> (Just (spanId parent), SpanContext (SId sid) (spanTraceId parent))
-                (_, Nothing) -> (Nothing, SpanContext (SId sid) (TId sid))
-                (_, Just ((spanContext -> SpanContext psid tid) :| _)) -> (Just psid, SpanContext (SId sid) tid)
-              !sp = Span ctx (T.pack operation) startedAt 0 (HM.singleton "thread_id" (StringTagValue $ T.pack $ show threadId)) mempty OK mpsid
-              !tracer = tracerPushSpan gTracer threadId sp
-          pure $! GlobalSharedMutableState gSpanExporter tracer
-      )
-      ( \_ exitcase -> do
-          liftIO $ modifyMVar_ globalSharedMutableState $ \GlobalSharedMutableState {..} -> do
-            let (mspan, tracer) = tracerPopSpan gTracer threadId
-            case mspan of
-              Nothing -> pure ()
-              Just sp -> do
-                finishedAt <- liftIO now64
-                let sp' = case (exitcase, autoTagError) of
-                      (ExitCaseSuccess {}, _) -> sp
-                      (_, Don'tAutoTagError) -> sp
-                      _ -> sp {spanTags = HM.insert "error" (BoolTagValue True) (spanTags sp)}
-                res <- export gSpanExporter [sp' {spanFinishedAt = finishedAt}]
-                case res of
-                  ExportSuccess -> pure ()
-                  _ -> error $ "exporting span failed: " <> show sp
-            pure $! GlobalSharedMutableState gSpanExporter tracer
-      )
-      (\_ -> action)
-  pure result
-
-setTag :: forall value m. (MonadIO m, ToTagValue value) => T.Text -> value -> m ()
-setTag k v =
-  modifyCurrentSpan
-    ( \sp ->
-        sp {spanTags = HM.insert k (toTagValue v) (spanTags sp)}
-    )
-
-addEvent :: forall m. MonadIO m => T.Text -> T.Text -> m ()
-addEvent name value = do
-  now <- liftIO now64
-  modifyCurrentSpan
-    ( \sp ->
-        sp {spanEvents = SpanEvent now name value : spanEvents sp}
-    )
-
-setParentSpanContext :: MonadIO m => SpanContext -> m ()
-setParentSpanContext (SpanContext psid tid) =
-  modifyCurrentSpan
-    ( \sp ->
-        sp
-          { spanContext = SpanContext (spanId sp) tid,
-            spanParentId = Just psid
-          }
-    )
-
-withOpenTelemetry :: (MonadIO m, MonadMask m) => OpenTelemetryConfig -> m a -> m a
-withOpenTelemetry OpenTelemetryConfig {..} action = do
-  bracket
-    ( liftIO $ do
-        tracer <- createTracer
-        modifyMVar_ globalSharedMutableState (\_ -> pure $ GlobalSharedMutableState otcSpanExporter tracer)
-        pure ()
-    )
-    (\_ -> liftIO $ shutdown otcSpanExporter)
-    (\_ -> action)
-
-data GlobalSharedMutableState
-  = GlobalSharedMutableState
-      { gSpanExporter :: !(Exporter Span),
-        gTracer :: !(Tracer ThreadId)
-      }
-
-withZeroConfigOpenTelemetry :: (MonadIO m, MonadMask m) => m a -> m a
-withZeroConfigOpenTelemetry action = do
-  (now, prog_name, tmp_dir) <- liftIO $ (,,) <$> now64 <*> getProgName <*> getTemporaryDirectory
-  exporter <- liftIO $ createFileSpanExporter $ printf "%s/%s-%d.trace.json" tmp_dir prog_name now
-  let otelConfig = OpenTelemetryConfig {otcSpanExporter = exporter}
-  withOpenTelemetry otelConfig action
-
-getCurrentSpanContext :: MonadIO m => m (Maybe SpanContext)
-getCurrentSpanContext = do
-  tid <- liftIO myThreadId
-  GlobalSharedMutableState {..} <- liftIO $ readMVar globalSharedMutableState
-  pure $ spanContext <$> tracerGetCurrentActiveSpan gTracer tid
-
-getCurrentActiveSpan :: MonadIO m => m (Maybe Span)
-getCurrentActiveSpan = do
-  tid <- liftIO myThreadId
-  GlobalSharedMutableState {..} <- liftIO $ readMVar globalSharedMutableState
-  pure $ tracerGetCurrentActiveSpan gTracer tid
-
-modifyCurrentSpan :: MonadIO m => (Span -> Span) -> m ()
-modifyCurrentSpan f = liftIO $ do
-  tid <- myThreadId
-  modifyMVar_
-    globalSharedMutableState
-    ( \g@(GlobalSharedMutableState {..}) ->
-        case HM.lookup tid (tracerSpanStacks gTracer) of
-          Nothing -> pure g
-          Just (sp :| sps) ->
-            let !stacks = HM.insert tid (f sp :| sps) (tracerSpanStacks gTracer)
-             in pure $! g {gTracer = gTracer {tracerSpanStacks = stacks}}
-    )
-
-withChildSpanOf :: (MonadIO m, MonadMask m) => Span -> String -> m a -> m a
-withChildSpanOf parent operation action = generalWithSpan (WithSpanOptions (ChildOf parent) DoAutoTagError) operation action
-
-globalSharedMutableState :: MVar GlobalSharedMutableState
-globalSharedMutableState = unsafePerformIO $ do
-  tracer <- createTracer
-  newMVar (GlobalSharedMutableState noopExporter tracer)
-{-# NOINLINE globalSharedMutableState #-}
diff --git a/src/OpenTelemetry/Propagation.hs b/src/OpenTelemetry/Propagation.hs
--- a/src/OpenTelemetry/Propagation.hs
+++ b/src/OpenTelemetry/Propagation.hs
@@ -1,50 +1,94 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 
 -- This is an approximate implementation of https://www.w3.org/TR/trace-context
 
 module OpenTelemetry.Propagation where
 
-import Data.Word
-import qualified Data.ByteString.Char8 as BS
+import Control.Applicative
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BS8
 import Data.Char (ord)
 import Data.List (find)
 import Data.String
-import GHC.Generics
-import OpenTelemetry.Common
+import Data.Word
+import OpenTelemetry.SpanContext
 import Text.Printf
 
-data TraceParent = TraceParent Int Int
-  deriving (Eq, Show, Generic)
+data PropagationFormat = PropagationFormat
+  { propagateFromHeaders :: forall key. (Semigroup key, IsString key, Eq key) => [(key, BS.ByteString)] -> Maybe SpanContext,
+    propagateToHeaders :: forall key. (Semigroup key, IsString key, Eq key) => SpanContext -> [(key, BS.ByteString)]
+  }
 
-extractSpanContextFromHeaders :: (IsString key, Eq key) => [(key, BS.ByteString)] -> Maybe SpanContext
-extractSpanContextFromHeaders headers =
-  case find ((== "traceparent") . fst) headers of
-    Just (_, (parseSpanContext -> mctx)) -> mctx
-    _ -> Nothing
+-- | (p1 <> p2) parses like p1, then p2 as a fallback. (p1 <> p2) injects like p1.
+instance Semigroup PropagationFormat where
+  PropagationFormat from1 to1 <> PropagationFormat from2 _to2 =
+    let from headers = from1 headers <|> from2 headers
+        to context = to1 context
+     in PropagationFormat from to
 
+w3cTraceContext :: PropagationFormat
+w3cTraceContext = PropagationFormat from to
+  where
+    from headers =
+      case find ((== "traceparent") . fst) headers of
+        Just (_, (parseSpanContext -> mctx)) -> mctx
+        _ -> Nothing
+    to (SpanContext (SId sid) (TId tid)) =
+      [("traceparent", BS8.pack $ printf "00-%x-%x-00" tid sid)]
+
+b3 :: PropagationFormat
+b3 = typical_opentracing_format_with_prefix "x-b3-"
+
+otTracer :: PropagationFormat
+otTracer = typical_opentracing_format_with_prefix "ot-tracer-"
+
+typical_opentracing_format_with_prefix :: String -> PropagationFormat
+typical_opentracing_format_with_prefix prefix = PropagationFormat from to
+  where
+    to (SpanContext (SId sid) (TId tid)) =
+      [ (fromString prefix <> "traceid", encode_u64 tid),
+        (fromString prefix <> "spanid", encode_u64 sid),
+        (fromString prefix <> "sampled", "true")
+      ]
+    from headers =
+      let traceidKey = fromString prefix <> "traceid"
+          spanidKey = fromString prefix <> "spanid"
+          go _ (Just tid, Just sid) = Just (tid, sid)
+          go [] _ = Nothing
+          go ((k, v) : xs) (tid, sid)
+            | k == traceidKey = go xs (decode_u64 v, sid)
+            | k == spanidKey = go xs (tid, decode_u64 v)
+            | otherwise = go xs (tid, sid)
+       in (\(t, s) -> SpanContext (SId s) (TId t)) <$> go headers (Nothing, Nothing)
+
 parseSpanContext :: BS.ByteString -> Maybe SpanContext
 parseSpanContext input =
-  case BS.split '-' input of
+  case BS8.split '-' input of
     ["00", (fromHex -> Just tid), (fromHex -> Just sid), _] ->
       Just $ SpanContext (SId sid) (TId tid)
     _ -> Nothing
 
-renderSpanContext :: SpanContext -> BS.ByteString
-renderSpanContext (SpanContext (SId sid) (TId tid)) =
-  BS.pack $ printf "00-%x-%x-00" tid sid
-
 isLowerHexDigit :: Char -> Bool
 isLowerHexDigit (ord -> w) = (w >= 48 && w <= 57) || (w >= 97 && w <= 102)
 
 fromHex :: BS.ByteString -> Maybe Word64
-fromHex bytes = BS.foldl' go (Just 0) bytes
+fromHex bytes = BS8.foldl' go (Just 0) bytes
   where
     go Nothing _ = Nothing
     go (Just !result) (ord -> d) | d >= 48 && d < 58 = Just $ result * 16 + fromIntegral d - 48
     go (Just result) (ord -> d) | d >= 97 && d < 124 = Just $ result * 16 + fromIntegral d - 87
     go _ _ = Nothing
 
-data PropagationFormat = W3CTraceContext
+encode_u64 :: Word64 -> BS.ByteString
+encode_u64 x = BS8.pack (printf "%016x" x)
 
-inject :: PropagationFormat -> SpanContext -> [(String, BS.ByteString)]
-inject W3CTraceContext ctx = [("traceparent", renderSpanContext ctx)]
+decode_u64 :: BS.ByteString -> Maybe Word64
+decode_u64 bytes | BS.length bytes > 16 = Nothing
+decode_u64 bytes = BS.foldl' go (Just 0) bytes
+  where
+    go Nothing _ = Nothing
+    go (Just !result) d | d >= 48 && d < 58 = Just $ result * 16 + fromIntegral d - 48
+    go (Just result) d | d >= 97 && d < 124 = Just $ result * 16 + fromIntegral d - 87
+    go _ _ = Nothing
diff --git a/src/OpenTelemetry/SpanContext.hs b/src/OpenTelemetry/SpanContext.hs
new file mode 100644
--- /dev/null
+++ b/src/OpenTelemetry/SpanContext.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module OpenTelemetry.SpanContext where
+
+import Data.Word
+import GHC.Generics
+import Text.Printf
+
+newtype TraceId = TId Word64
+  deriving (Eq, Generic)
+
+instance Show TraceId where
+  show (TId tid) = printf "(TraceId 0x%x)" tid
+
+newtype SpanId = SId Word64
+  deriving (Eq, Generic)
+
+instance Show SpanId where
+  show (SId sid) = printf "(SpanId 0x%x)" sid
+
+data SpanContext = SpanContext !SpanId !TraceId
+  deriving (Show, Eq, Generic)
diff --git a/unit-tests/Main.hs b/unit-tests/Main.hs
deleted file mode 100644
--- a/unit-tests/Main.hs
+++ /dev/null
@@ -1,1 +0,0 @@
-{-# OPTIONS_GHC -F -pgmF tasty-discover #-}
diff --git a/unit-tests/TestCommon.hs b/unit-tests/TestCommon.hs
deleted file mode 100644
--- a/unit-tests/TestCommon.hs
+++ /dev/null
@@ -1,34 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module TestCommon where
-
-import Data.Word
-import OpenTelemetry.Common
-
-mkTestSpan :: Word64 -> Word64 -> Span
-mkTestSpan sid tid =
-  Span
-    { spanContext = SpanContext (SId sid) (TId tid),
-      spanStartedAt = 0,
-      spanFinishedAt = 10,
-      spanTags = mempty,
-      spanEvents = mempty,
-      spanStatus = OK,
-      spanOperation = "foo",
-      spanParentId = Nothing
-    }
-
-prop_tracer_push_does_something :: Word64 -> Word64 -> Int -> Bool
-prop_tracer_push_does_something sid tid threadid =
-  let tracer0 = Tracer mempty
-      sp0 = mkTestSpan sid tid
-      tracer1 = tracerPushSpan tracer0 threadid sp0
-   in tracer0 /= tracer1
-
-prop_tracer_push_pop :: Word64 -> Word64 -> Int -> Bool
-prop_tracer_push_pop sid tid threadid =
-  let tracer0 = Tracer mempty
-      sp0 = mkTestSpan sid tid
-      tracer1 = tracerPushSpan tracer0 threadid sp0
-      (Just sp1, tracer2) = tracerPopSpan tracer1 threadid
-   in tracer0 == tracer2 && sp0 == sp1
diff --git a/unit-tests/TestPropagation.hs b/unit-tests/TestPropagation.hs
deleted file mode 100644
--- a/unit-tests/TestPropagation.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeApplications #-}
-
-module TestPropagation where
-
-import qualified Data.ByteString.Char8 as BS
-import Data.Word
-import OpenTelemetry.Common
-import OpenTelemetry.Propagation
-import Test.Tasty.HUnit
-import Text.Printf
-
-prop_render_parse_roundtrip :: Word64 -> Word64 -> Bool
-prop_render_parse_roundtrip sid tid =
-  let c = SpanContext (SId sid) (TId tid)
-   in Just c == extractSpanContextFromHeaders @String [("traceparent", renderSpanContext c)]
-
-unit_render_smoke :: Assertion
-unit_render_smoke =
-  renderSpanContext (SpanContext (SId 1) (TId 2)) @?= "00-2-1-00"
-
-unit_parse_smoke :: Assertion
-unit_parse_smoke =
-  extractSpanContextFromHeaders @String [("traceparent", "00-2-1-00")] @?= Just (SpanContext (SId 1) (TId 2))
-
-prop_fromHex :: Word64 -> Bool
-prop_fromHex x =
-  Just x == fromHex (BS.pack $ printf "%x" x)
-
-unit_fromHex_smoke :: Assertion
-unit_fromHex_smoke =
-  Just 1 @?= fromHex "1"